Forum FlexPro – Discuss your topic!

Automatischer Datenimport mit VBA

Schlagwörter: Datenimport VBA Exists-Method

Dieses Thema hat 2 Antworten sowie 3 Teilnehmer und wurde zuletzt vor vor 6 Jahren, 4 Monaten von Tjark Köbinger aktualisiert.

Viewing 3 posts - 1 through 3 (of 3 total)

Autor

Beiträge

März 22, 2017 um 12:30 pm Uhr #14196

Adolfo Tello

Teilnehmer

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!

März 27, 2017 um 7:15 pm Uhr #14277

Anonym

Inaktiv

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

Juni 27, 2018 um 1:59 pm Uhr #20990

Tjark Köbinger