[VBA + Access] Voor import controle op filename.

[jordan2k]

Ben bezig met een macro om data automatisch te importeren van excel naar access. Dit werkt al aardig maar nu wil ik een controlen maken die bijhoud welke files ziijn geimporteerd en waneer. Ik kan nu aleen niet terug vinden hoe je 1 record toevoegd aan een table via VBA.

code:

Private Sub Import_Click()

Dim strFileName As String, strFileName1 As String, sTableName As String, strPath As String
Dim i As Integer
Dim fs As Object
Set fs = Application.FileSearch
With fs
    .LookIn = "C:\XlsImport-Export\ActualScotland" 'define dir
    .fileName = "*.xls" 'define file type
    If .Execute(SortBy:=msoSortbyFileName, _
    SortOrder:=msoSortOrderDescending) > 0 Then
        For i = 1 To .FoundFiles.Count
   

strPath = .FoundFiles(i)
strFileName = Dir(strPath)
strFileName1 = Left$([strFileName], InStr(1, [strFileName], ".") - 1)
sTableName = Mid(Replace(strFileName1, " ", ""), InStr(1, (Replace(strFileName1, " ", "")), "-") + 1)
Sfilename = strFileName

         MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found. And you want to Import " & strFileName
  'lookup if Sfilename excist in imported files if true then next else import
  'if import then ammend the file name to the imported files table

   DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            "" & sTableName & "", strPath, True
   Next i
    Else
        MsgBox "There were no files found."
    End If
End With

End Sub

Dus voor de import moet gekeken worden is file all geimporteerd dan sla over.
en waneer nog niet dan importeren.

nu is mn vraag hoe voeg je met VBA 1 record toe aan een table.
en hoe query je dat daar weer uit zodat je kan vergelijken.

[Black Hawk]

Maak een tabel aan die heet ImportedFiles (oid) met 1 kolom, met als naam FileName (als je wilt kan je bijv een tweede kolom aanmaken voor de datum/tijd wanneer dat bestand ingevoerd is om later te kunnen refreshen oid, maar ik ga er van uit van 1 kolom)

Visual Basic:

Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT FileName FROM ImportedFiles " & _
                                   WHERE FileName = '" & strFileName & "'")

If rs.EOF = true         ' -- EOF = End Of File --
    'hier komt al je code voor het ophalen en in het plaatsen in de db van de gegevens

    DoCmd.RunSQL "INSERT INTO ImportedFiles VALUES('" & strFileName & "')"
End if

[jordan2k]

op een of andere manier wilt dit niet werken hij blijft aan geven dat die query's niet goed gaan.

de select en insert into gaan niet goed.

[jordan2k]

Problem Solved

code:

Private Sub Import_Click()
'========================================================================
'MHE Import XLS to Actual Table
'Function: Importing a *.Xls File to the Database from a predifined Path.
'========================================================================
'Dim.
Dim strFileName As String       'Filename
Dim strFileName1 As String      'Filename1
Dim sTableName As String        'Table Name
Dim strPath As String           'Full Path
Dim i As Integer                'Counter
Dim fs As Object                'FileSearch
Dim Rs As DAO.Recordset           'Recordset
Dim XlsPath As String           'Import Path
Dim Filename As String
Dim SQLQ1 As String
'Set vars.
sTableName = "Actual2004"                           'Set Table Name
XlsPath = "C:\XlsImport-Export\ActualScotland"      'Define Import Path
FileExt = "*.xls"                                   'Define Extention Excell file
'Start File Search
Set fs = Application.FileSearch
With fs
    .LookIn = XlsPath
    .Filename = FileExt
    If .Execute(SortBy:=msoSortbyFileName, _
    SortOrder:=msoSortOrderDescending) > 0 Then
        For i = 1 To .FoundFiles.Count              'Start Loop

        strPath = .FoundFiles(i)
        strFileName = Dir(strPath)
        strFileName1 = Left$([strFileName], InStr(1, [strFileName], ".") - 1)

        SQLQ1 = "SELECT ImportedFiles.FileName FROM ImportedFiles WHERE ImportedFiles.FileName = '" & strFileName1 & "'"
        Set Rs = CurrentDb.OpenRecordset(SQLQ1)

        'MsgBox ("Query =  " & Rs & " | Filename =  " & strFileName1 & "")
    If Rs.EOF = True Then
        DoCmd.RunSQL "INSERT INTO ImportedFiles (Filename) VALUES('" & strFileName1 & "')"
        'Import ExcelSheet to Access Table Actuals
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                                    "" & sTableName & "", strPath, True
    Else
        'If rs.EOF = true         ' -- EOF = End Of File --
         'DoCmd.RunSQL "SELECT Filename FROM ImportedFiles WHERE Filename = '" & .strFileName & "'"
        'Insert FileName in #ImportedFiles Table Before/After Import.
        'Debug MsgBox
        'MsgBox "Going to add : " & strFileName & "  To ImportedFiles Table."
        'DoCmd.RunSQL "INSERT INTO ImportedFiles (Filename) VALUES('" & strFileName1 & "')"
        'Import ExcelSheet to Access Table Actuals
        'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                                    "" & sTableName & "", strPath, True
        MsgBox ("File(s) Already imported:...")
    End If
Next i      'Loop Next File
End If      'End For I = 1 to ...
End With    'End With fs
End Sub

[ Voor 56% gewijzigd door jordan2k op 09-11-2004 14:47 ]