Automatischer Datenimport mit VBA

[Adolfo Tello]

Guten Tag,

Ich würde gerne mit einen Makro Dateien automatisch importieren. Mein Problem ist, dass mein Makro die bereits existierenden Dateien erneut importieren. Ich Versuche mit der Funktion “ObjectExists” mein Vaterordner nach den existierenden Dateien durch zu suchen.

Dim folderspec

folderspec = ActiveDatabase.Path & "\Messdaten"

Dim FSO, folder

Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder = FSO.GetFolder(folderspec)

Dim StTyp$, pathDatei$, DateiName$, UPTyp$, DateiAnzahl%
Dim SearchFolder As Object
Dim FI As Object
Dim EachFil As Object

StTyp = "dat" 'Dateityp

Set SearchFolder = FSO.GetFolder(folderspec)

Set EachFil = SearchFolder.Files ' Dateien in der jeweiligen Root

For j = 1 To UPanzahl

    For Each FI In EachFil ' Schleife über alle Dateien

        If UCase(Right(FI.Name, Len(FI.Name) - InStrRev(FI.Name, "."))) = UCase(StTyp) Then

            DateiName = UCase(Left(FI.Name, InStrRev(FI.Name, ".") - 1))

            If InStrRev(FI.Name, UPLabel(j)) > 0 Then

                pathDatei = folderspec & "\" & FI.Name

                If folders_UP.ObjectExists(DateiName) = False Then
                    ImportSettings.CreateLinks = False
                    ActiveDatabase.Object("\Auswertung_µPST\" & UPLabel(j) & "\01_Messdaten", fpObjectTypeFolder).Import pathDatei, "NI DAGO/DIAdem Header-Dateien (*.dat)|*.dat"
                End If
            End If
        End If
    Next FI
Next j`

Vielen Dank!

[Anonymous]

Ein Skript, das nur die nicht als Ordner existierenden Dateien in einen Zielordner importiert, könnte etwas so aussehen:

Sub ImportNonExistingFiles(oTargetFolder As Folder, strFilePath As String)
    Dim oFS As New Scripting.FileSystemObject
    Dim oFolder As Scripting.Folder
    Dim oFile As Scripting.File
    
    '   prepare import settings once
    With ImportSettings
        .CreateLinks = False
        .CreateFolder = True
    End With
    
    Set oFolder = oFS.GetFolder(strFilePath)
    
'    For j = 1 To UPanzahl
        For Each oFile In oFolder.Files ' Schleife über alle Dateien
            If UCase(oFS.GetExtensionName(oFile.Name)) = UCase("dat") Then
                'If InStrRev(oFile.Name, UPLabel(j)) > 0 Then
                    If oTargetFolder.ObjectExists(oFS.GetBaseName(oFile.Name), fpObjectTypeFolder) = False Then
                        Debug.Print "Importiere " & oFile.Path
                        oTargetFolder.Import oFile.Path, "NI DAGO/DIAdem Header-Dateien (*.dat)|*.dat"
                    End If
                'End If
            End If
        Next oFile
 '   Next j
End Sub

Die Herkunft der Variable UPAnzahl und UPLabel ist unklar, die entsprechenden Zeilen sind deshalb auskommentiert. Sie werden aber u. U. nicht benötigt. Der Aufruf könnte dann z. B. so aussehen:

ImportNonExistingFiles ActiveDatabase.RootFolder, ActiveDatabase.Path & "\Messdaten"

Bitte beachten Sie, dass Sie in VBA unter Extras/Verweise noch einen Verweis auf die “Microsoft Scripting Runtime” eintragen müssen, damit die Funktion ausgeführt werden kann.

Support
support@weisang.com

 

[Tjark Köbinger]

Guten Tag,

auch ich würde gerne csv-Dateien automatisch importieren. Ich dachte dieser Code ist eine gute Grundlage. Allerdings wird mir das Makro erst gar nicht zum auswählen und ausführen angezeigt. Dies ist der Fall sobald das Makro Eingangsgrößen enthält. Mit einem Makro der Form Makro() funktioniert alles wie gewünscht. Wie kann ich obiges Makro ausführen?

Vielen Dank!

[Author]

Posts