Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Datenimport mit Variablen Pfad


Betrifft: Datenimport mit Variablen Pfad von: Okan
Geschrieben am: 10.04.2018 10:17:19

Guten Tag,

ich habe folgendes Problem. Ich nutze Makros um einen Datenimport durchzuführen, wobei die Tabellenblattbezeichnung Variabel ist.
Jedoch hätte ich auch gerne den Teil SearchLike Variabel um Programmierarbeiten zu Sparen. Bzw. Copy und Paste.

Hier das Aktuelle Makro:

Public Sub Import_Data(wks As Worksheet)
  On Error GoTo ErrorHandler
  Dim objFileSearch As clsFileSearch
  Dim lngIndex As Long, lngCount As Long
  Dim varOutput As Variant
  Dim strPath As String, strFormula As String
  
  Const cstrTabname As String = "Report" 'Tabellenname

  With wks
    
    If .Range("C7") = "" Or .Range("C8") = "" Then
      MsgBox ("Bitte Cellen C7 & C8 mit Daten füllen.")
    Else
      strPath = _
        "I:\TS_Dokument\Partikelfallenanalyse\Analyse\" & .Cells(7, 3).Value & "\" & .Cells(8,  _
3).Value & "\"  ' _
        Startverzeichnis
      
      If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
      .Range("B17:C36").ClearContents
      Set objFileSearch = New clsFileSearch
      With objFileSearch
        .NewSearch = True
        .CaseSenstiv = False
        .Extension = "*.xlsx*"
        .FolderPath = strPath
        .SearchLike = "*Partikelfallenanalyse_CAR_" & wks.Name & "_*"
        .SubFolders = False
        If .Execute(Sort_by_Name, Sort_Order_Descending) > 0 Then
          ReDim varOutput(1 To 20, 1 To 10)
          lngCount = 1
          For lngIndex = 1 To .FileCount
            If lngCount > 20 Then Exit For
            strFormula = "='" & .Files(lngIndex).FI_FolderPath
            strFormula = strFormula & "[" & .Files(lngIndex).FI_FileName & "]"
            strFormula = strFormula & cstrTabname & "'!"
            varOutput(lngCount, 1) = strFormula & "U50"
            varOutput(lngCount, 2) = strFormula & "I19"
            varOutput(lngCount, 3) = strFormula & "I20"
            varOutput(lngCount, 4) = strFormula & "I21"
            varOutput(lngCount, 5) = strFormula & "I22"
            varOutput(lngCount, 6) = strFormula & "I23"
            varOutput(lngCount, 7) = strFormula & "I24"
            varOutput(lngCount, 8) = strFormula & "I25"
            varOutput(lngCount, 9) = strFormula & "I26"
            varOutput(lngCount, 10) = strFormula & "U46"
            lngCount = lngCount + 1
          Next
        End If
      End With
      With .Range("B17").Resize(UBound(varOutput, 1), 10)
        .Formula = varOutput
        .Value = .Value
      End With
    
    
    Set objFileSearch = Nothing
  End If
  End With
  Exit Sub
ErrorHandler:
MsgBox ""
End Sub
Meine Lösung funktioniert leider nicht.
Public Sub Import_Data(wks As Worksheet)
  On Error GoTo ErrorHandler
  Dim objFileSearch As clsFileSearch
  Dim lngIndex As Long, lngCount As Long
  Dim varOutput As Variant
  Dim strPath As String, strFormula As String
  
  Const cstrTabname As String = "Report" 'Tabellenname

  With wks
    
    If .Range("C7") = "" Or .Range("C8") = "" Then
      MsgBox ("Bitte Cellen C7 & C8 mit Daten füllen.")
    Else
      strPath = _
        "I:\TS_Dokument\Partikelfallenanalyse\Analyse\" & .Cells(7, 3).Value & "\" & .Cells(8,  _
3).Value & "\"  ' _
        Startverzeichnis
      
      If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
      .Range("B17:C36").ClearContents
      Set objFileSearch = New clsFileSearch
      With objFileSearch
        .NewSearch = True
        .CaseSenstiv = False
        .Extension = "*.xlsx*"
        .FolderPath = strPath
        .SearchLike = "*Partikelfallenanalyse_" & .Cells(7, 3).Value & "_" & wks.Name & "_*"
        .SubFolders = False
        If .Execute(Sort_by_Name, Sort_Order_Descending) > 0 Then
          ReDim varOutput(1 To 20, 1 To 10)
          lngCount = 1
          For lngIndex = 1 To .FileCount
            If lngCount > 20 Then Exit For
            strFormula = "='" & .Files(lngIndex).FI_FolderPath
            strFormula = strFormula & "[" & .Files(lngIndex).FI_FileName & "]"
            strFormula = strFormula & cstrTabname & "'!"
            varOutput(lngCount, 1) = strFormula & "U50"
            varOutput(lngCount, 2) = strFormula & "I19"
            varOutput(lngCount, 3) = strFormula & "I20"
            varOutput(lngCount, 4) = strFormula & "I21"
            varOutput(lngCount, 5) = strFormula & "I22"
            varOutput(lngCount, 6) = strFormula & "I23"
            varOutput(lngCount, 7) = strFormula & "I24"
            varOutput(lngCount, 8) = strFormula & "I25"
            varOutput(lngCount, 9) = strFormula & "I26"
            varOutput(lngCount, 10) = strFormula & "U46"
            lngCount = lngCount + 1
          Next
        End If
      End With
      With .Range("B17").Resize(UBound(varOutput, 1), 10)
        .Formula = varOutput
        .Value = .Value
      End With
    
    
    Set objFileSearch = Nothing
  End If
  End With
  Exit Sub
ErrorHandler:
MsgBox ""
End Sub
Ich bedanke mich im Voraus.

VG
Okan

  

Betrifft: AW: Datenimport mit variablem Pfad von: Rudi Maintaire
Geschrieben am: 10.04.2018 12:41:20

Hallo,
falsche Referenzierung.

.SearchLike = "*Partikelfallenanalyse_" & wks.Cells(7, 3).Value & "_" & wks.Name & "_*"
Gruß
Rudi


  

Betrifft: AW: Datenimport mit variablem Pfad von: Okan
Geschrieben am: 10.04.2018 13:46:55

Hi Rudi,

danke für die schnelle Rückmeldung.

VG
Okan


Beiträge aus dem Excel-Forum zum Thema "Datenimport mit Variablen Pfad"