Ordner auswählen & eintragen in Makro mittels VBA

[Kuwer]

Hallo Tobi,

das musst Du entsprechend einbauen:

  If ExecuteExcel4Macro("'" & strPfad & "[" & strDateiname & "]Tabelle1'!R106C2") = "XY" Then

   Makro1

 Else

   Makro2

 End If

Gruß Uwe

[tobisw]

Hallo ihr 2,

ich habe es jetzt ca. 2 Stunden probiert und diesen Zusatz an unterschiedlichsten Stellen in meinen Code eingesetzt. Aber irgendwie komme ich nicht zum finalen Ergebnis. Leider bin ich absolut kein VBA Kenner, so dass ich auch nicht weiß, wo mein Fehler liegt.

Ich habe einmal unten 2 Beispieldateien hochgeladen, wo die VBA Abfrage prüfen soll, ob in der Zelle I6 der Text "test confidential" vorkommt.
Wenn ja, soll er das Makro "alteversionauswerten" aufrufen - wenn es leer ist, dann Makro "neueversionauswerten" vornehmen und entsprechend in eine extra Datei dann die Daten schreiben soll.

Wie bereits geschrieben, weiß ich nicht, wo ich diesen Aufruf jetzt genau einbauen muss, damit er dies für jede Datei in einem Ordner durchprüft.

Bin am verzweifeln und verliere schon meine letzten Haare :s 

Hier auch noch mal mein bisheriger Code (aus meiner Datei, wo die auszulesenden Daten gespeichert werden), der jedoch momentan noch keinen Abgleich anhand eines bestimmten Textes in einer Datei vornimmt:

Code:

Option Explicit

Sub QAFsauswerten()

   Dim strDateiname As String
   Dim strPfad      As String
   Dim lngZeile     As Long

With Application.FileDialog(msoFileDialogFolderPicker)
   .InitialFileName = "c:\" '"C:\Users\z563164\Desktop\testquaf"
   .Title = "Ordner"
   .ButtonName = "your Choice :)"
   .InitialView = msoFileDialogViewList
   If .Show = -1 Then
       strPfad = .SelectedItems(1)
       If Right(strPfad, 1) <> "\" Then strPfad = strPfad & "\"
   Else
       strPfad = ""
   End If
End With
If strPfad = "" Then
   Exit Sub
Else
   'Den 1. Dateinamen holen
   strDateiname = Dir(strPfad & "*.xls")

   'Startzeile festlegen
   lngZeile = 2
   
   'Solange ein Dateiname gelesen wird
   Do While Not strDateiname = ""
       
       'Datei verarbeiten
       Call TabVerarb(strPfad & strDateiname, lngZeile)
       
       'nächsten Dateinamen holen
       strDateiname = Dir()
       
       'Zeilenzähler erhöhen
       lngZeile = lngZeile + 1
    Loop
End If
End Sub




Public Sub TabVerarb(strPfad As String, lngZeile As Long)
   Dim strMeSH As String
   Dim strDatei As String
   Dim strSH As String
   
 'Dateinamen extrahieren
   strDatei = Split(strPfad, "\")(UBound(Split(strPfad, "\")))
   
   'Eigenen Namen merken
   strMeSH = ActiveWorkbook.Name
   
   'Datei öffnen
   Workbooks.Open Filename:=strPfad
   
   With Workbooks(strMeSH)
       'Dateinamen und auszuwertenden Zellen übertragen
       .Sheets("Tabelle1").Cells(lngZeile, 1) = strDatei
       .Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Summary").Range("G16").Value
       .Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Summary").Range("K8").Value
       .Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Summary").Range("D27").Value
       .Sheets("Tabelle1").Cells(lngZeile, 5) = Workbooks(strDatei).Sheets("Summary").Range("D26").Value
   .Sheets("Tabelle1").Cells(lngZeile, 6) = Workbooks(strDatei).Sheets("Summary").Range("J27").Value
   .Sheets("Tabelle1").Cells(lngZeile, 7) = Workbooks(strDatei).Sheets("Summary").Range("J28").Value
   .Sheets("Tabelle1").Cells(lngZeile, 8) = Workbooks(strDatei).Sheets("Summary").Range("J29").Value
   .Sheets("Tabelle1").Cells(lngZeile, 9) = Workbooks(strDatei).Sheets("Summary").Range("K29").Value
   .Sheets("Tabelle1").Cells(lngZeile, 10) = Workbooks(strDatei).Sheets("Summary").Range("J31").Value
   .Sheets("Tabelle1").Cells(lngZeile, 11) = Workbooks(strDatei).Sheets("Summary").Range("K31").Value
   .Sheets("Tabelle1").Cells(lngZeile, 12) = Workbooks(strDatei).Sheets("Summary").Range("J32").Value
   .Sheets("Tabelle1").Cells(lngZeile, 13) = Workbooks(strDatei).Sheets("Summary").Range("J35").Value
   .Sheets("Tabelle1").Cells(lngZeile, 14) = Workbooks(strDatei).Sheets("Summary").Range("J37").Value
   .Sheets("Tabelle1").Cells(lngZeile, 15) = Workbooks(strDatei).Sheets("Summary").Range("K37").Value
   .Sheets("Tabelle1").Cells(lngZeile, 16) = Workbooks(strDatei).Sheets("Summary").Range("B40").Value
   .Sheets("Tabelle1").Cells(lngZeile, 17) = Workbooks(strDatei).Sheets("Summary").Range("J48").Value
   .Sheets("Tabelle1").Cells(lngZeile, 18) = Workbooks(strDatei).Sheets("Summary").Range("J49").Value
   .Sheets("Tabelle1").Cells(lngZeile, 19) = Workbooks(strDatei).Sheets("Summary").Range("J57").Value
   .Sheets("Tabelle1").Cells(lngZeile, 20) = Workbooks(strDatei).Sheets("Summary").Range("J64").Value
   .Sheets("Tabelle1").Cells(lngZeile, 21) = Workbooks(strDatei).Sheets("Summary").Range("J65").Value
   .Sheets("Tabelle1").Cells(lngZeile, 22) = Workbooks(strDatei).Sheets("Summary").Range("J66").Value
   .Sheets("Tabelle1").Cells(lngZeile, 23) = Workbooks(strDatei).Sheets("Summary").Range("J72").Value
   .Sheets("Tabelle1").Cells(lngZeile, 24) = Workbooks(strDatei).Sheets("Summary").Range("J73").Value
   .Sheets("Tabelle1").Cells(lngZeile, 25) = Workbooks(strDatei).Sheets("Summary").Range("J74").Value
   .Sheets("Tabelle1").Cells(lngZeile, 26) = Workbooks(strDatei).Sheets("Summary").Range("J80").Value
   .Sheets("Tabelle1").Cells(lngZeile, 27) = Workbooks(strDatei).Sheets("Summary").Range("J82").Value
   .Sheets("Tabelle1").Cells(lngZeile, 28) = Workbooks(strDatei).Sheets("Summary").Range("J83").Value
   .Sheets("Tabelle1").Cells(lngZeile, 29) = Workbooks(strDatei).Sheets("Summary").Range("J84").Value
   .Sheets("Tabelle1").Cells(lngZeile, 30) = Workbooks(strDatei).Sheets("Summary").Range("J93").Value
   .Sheets("Tabelle1").Cells(lngZeile, 31) = Workbooks(strDatei).Sheets("Summary").Range("G94").Value
   .Sheets("Tabelle1").Cells(lngZeile, 32) = Workbooks(strDatei).Sheets("Summary").Range("G95").Value
   .Sheets("Tabelle1").Cells(lngZeile, 33) = Workbooks(strDatei).Sheets("Summary").Range("G98").Value
   .Sheets("Tabelle1").Cells(lngZeile, 34) = Workbooks(strDatei).Sheets("Summary").Range("J103").Value
   .Sheets("Tabelle1").Cells(lngZeile, 35) = Workbooks(strDatei).Sheets("Material").Range("E15").Value
   .Sheets("Tabelle1").Cells(lngZeile, 36) = Workbooks(strDatei).Sheets("Material").Range("J15").Value
   .Sheets("Tabelle1").Cells(lngZeile, 37) = Workbooks(strDatei).Sheets("Material").Range("O15").Value
   .Sheets("Tabelle1").Cells(lngZeile, 38) = Workbooks(strDatei).Sheets("Material").Range("P15").Value
   .Sheets("Tabelle1").Cells(lngZeile, 39) = Workbooks(strDatei).Sheets("Material").Range("Q15").Value
   .Sheets("Tabelle1").Cells(lngZeile, 40) = Workbooks(strDatei).Sheets("Material").Range("R15").Value
   .Sheets("Tabelle1").Cells(lngZeile, 41) = Workbooks(strDatei).Sheets("Material").Range("T15").Value
 
   
   
   
   
   End With
   
   'Quelldatei schließen
   Workbooks(strDatei).Saved = True
   Workbooks(strDatei).Close

End Sub

[Kuwer]

Hallo Tobi,

Sub QAFsauswerten()



  Dim strDateiname As String

  Dim strPfad      As String

  Dim lngZeile     As Long



With Application.FileDialog(msoFileDialogFolderPicker)

  .InitialFileName = "c:\" '"C:\Users\z563164\Desktop\testquaf"

  .Title = "Ordner"

  .ButtonName = "your Choice :)"

  .InitialView = msoFileDialogViewList

  If .Show = -1 Then

      strPfad = .SelectedItems(1)

      If Right(strPfad, 1) <> "\" Then strPfad = strPfad & "\"

  Else

      strPfad = ""

  End If

End With

If strPfad = "" Then

  Exit Sub

Else

  'Den 1. Dateinamen holen

  strDateiname = Dir(strPfad & "*.xls")



  'Startzeile festlegen

  lngZeile = 2

  

  'Solange ein Dateiname gelesen wird

  Do While Not strDateiname = ""

      

      'Datei verarbeiten

      

      'was steht in Zelle I6?

      If ExecuteExcel4Macro("'" & strPfad & "[" & strDateiname & "]Tabelle1'!R6C9") = "test confidential" Then

         Call alteversionauswerten(strPfad & strDateiname, lngZeile)

      Else

         Call neueversionauswerten(strPfad & strDateiname, lngZeile)

      End If

      

      'nächsten Dateinamen holen

      strDateiname = Dir()

      

      'Zeilenzähler erhöhen

      lngZeile = lngZeile + 1

   Loop

End If

End Sub

Gruß Uwe

[tobisw]

Hallo Uwe,

danke für deine Hilfe. Jetzt bekomme ich einen 1004 Laufzeitfehler Fehlermeldung beim Ausführen des Makros, wobei er folgende Zeile gelb hinterlegt hat:

Code:

If ExecuteExcel4Macro("'" & strPfad & "[" & strDateiname & "]Summary'!D15") = "confidential:" Then

Im Fehlertext steht: Die eingegebene Formel enthält  einen Fehler. Überprüfen Sie, ob alle erforderlichen Klammern und Argumente vorhanden sind
ÜBerprüfen Sie alle Bezüge auf andere Blätter oder ARbeitsmappen.
Sofern Sie keine Formel eingeben, vermeiden sie Gleichheitszeichen......



Gruß
Tobi

[Kuwer]

Hallo Tobi,

die Zelladresse muss im R1C1-Stil angegeben werden. Siehe auch hier: Daten aus geschlossener Mappe (1) - Mit Excel4Macro

Gruß Uwe

[tobisw]

Hi Uwe,

SUPER Vielen Dank! Kleiner Unterschied aber mit großer Wirkung! Jetzt funktioniert das Makro genauso wie ich es mir vorgestellt habe.

DANKE!

Für alle anderen die das gleiche Problem haben oder einmal haben werden, ich habe nach einem Begriff in D15 gesucht - nach der R1C1 Schreibweise
musste ich noch R15C4 eingeben, anstatt D15. Damit lief dann das Makro einwandfrei durch.

Viele Grüße
Tobi