Clever-Excel-Forum › Office-Anwendungen › Excel v
Ordner auswählen & eintragen in Makro mittels VBA

Thema geschlossen 
Baumstrukturmodus
Ordner auswählen & eintragen in Makro mittels VBA
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#11
02.08.2016, 22:42
Hallo Tobi,

das musst Du entsprechend einbauen:
  If ExecuteExcel4Macro("'" & strPfad & "[" & strDateiname & "]Tabelle1'!R106C2") = "XY" Then
   Makro1
 Else
   Makro2
 End If
Gruß Uwe
Suchen
Top
tobisw Offline
pausiert
ThreadStarter
Registriert seit: 17.07.2016
Version(en): 2016
#12
03.08.2016, 21:28 (Dieser Beitrag wurde zuletzt bearbeitet: 03.08.2016, 21:29 von 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


Angehängte Dateien
.xlsx   alteversion.xlsx (Größe: 8,29 KB / Downloads: 1)
.xlsx   neueversion.xlsx (Größe: 8,27 KB / Downloads: 7)
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#13
03.08.2016, 21:52
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
Suchen
Top
tobisw Offline
pausiert
ThreadStarter
Registriert seit: 17.07.2016
Version(en): 2016
#14
05.08.2016, 12:58
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
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#15
05.08.2016, 16:57
Hallo Tobi,

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

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • tobisw
Suchen
Top
tobisw Offline
pausiert
ThreadStarter
Registriert seit: 17.07.2016
Version(en): 2016
#16
05.08.2016, 19:59
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
Suchen
Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste