Thema Datum  Von Nutzer Rating
Antwort
Rot 2 Ordner auslesen
12.01.2021 07:16:31 Charles
Solved
12.01.2021 08:45:52 volti
Solved
12.01.2021 10:02:42 Gast43032
NotSolved

Ansicht des Beitrags:
Von:
Charles
Datum:
12.01.2021 07:16:31
Views:
49
Rating: Antwort:
 Nein
Thema:
2 Ordner auslesen

Hi! Brauche eure Hilfe!

Ich habe einen Quellcode mit dem ich aus einem Ordner (Aufträge) verschiedene Daten aus Excel Dateien auslese.

Kann ich mit dem selben Quellcode einen 2. Ordner Aufträge_1 auslesen? 

Hab den Quellcode von meinem Vorgänger übernommen und bin absoluter VBA Neuling!

Danke für eure Unterstützung

 

Sub GetData()

Set oMe = ThisWorkbook.ActiveSheet 'ZielDatei/-Tabelle (= die aktuelle Tabelle der aktuellen Datei)

Const sDateiPfad As String = "T:\20_Laboratory\TR\01_SK\01_P\Aufträge\" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende

sZelle1 = "B5" 'NOx 1. Temp.
sZelle2 = "B4" 'NOx 1. K-Wert.
sZelle3 = "C5" 'NOx 2. Temp.
sZelle4 = "C4" 'Nox 2. K-Wert.
sZelle5 = "D5" 'SOx 1. Temp.
sZelle6 = "D4" 'SOx 1. ETA
sZelle7 = "E5" 'SOx 2. Temp.
sZelle8 = "E4" 'SOx 2. ETA
sZelle9 = "F4" 'Porenvolumen.
sZelle10 = "G4" 'Abrieb
sZelle11 = "H4" 'BET
sZelle12 = "I4" 'Druckprüfung long.
sZelle13 = "J4" 'Druckprüfung trans.
sZelle14 = "K4" 'Vanadium ist
sZelle15 = "G2" 'Vanadium soll
sZelle16 = "A1" 'Auftragsnummer+Name
sZelle17 = "K1" 'Jahr
iZeile = 2 'ab Zeile 2 in Zieltabelle eintragen
iSpalte = 1 'ab Spalte A in Zieltabelle eintragen

Set oFS = CreateObject("Scripting.FileSystemObject")


For Each oDatei In oFS.GetFolder(sDateiPfad).Files


    sWbName = oDatei.Name

    If Left(LCase(oFS.GetExtensionName(sWbName)), 3) = "xls" Then


        Workbooks.Open (sDateiPfad & sWbName)
        Set Wsh = Workbooks(sWbName).Sheets("Übersicht")
        
        With oMe.Cells(iZeile, iSpalte)
           .Offset(0, 0).Value = Wsh.Range(sZelle1).Value
           .Offset(0, 1).Value = Wsh.Range(sZelle2).Value
           .Offset(0, 2).Value = Wsh.Range(sZelle3).Value
           .Offset(0, 3).Value = Wsh.Range(sZelle4).Value
           .Offset(0, 4).Value = Wsh.Range(sZelle5).Value
           .Offset(0, 5).Value = Wsh.Range(sZelle6).Value
           .Offset(0, 6).Value = Wsh.Range(sZelle7).Value
           .Offset(0, 7).Value = Wsh.Range(sZelle8).Value
           .Offset(0, 8).Value = Wsh.Range(sZelle9).Value
           .Offset(0, 9).Value = Wsh.Range(sZelle10).Value
           .Offset(0, 10).Value = Wsh.Range(sZelle11).Value
           .Offset(0, 11).Value = Wsh.Range(sZelle12).Value
           .Offset(0, 12).Value = Wsh.Range(sZelle13).Value
           .Offset(0, 13).Value = Wsh.Range(sZelle14).Value
           .Offset(0, 14).Value = Wsh.Range(sZelle15).Value
           .Offset(0, 15).Value = Wsh.Range(sZelle16).Value
           .Offset(0, 16).Value = Wsh.Range(sZelle17).Value
           oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, iSpalte + 17), Address:=sDateiPfad & sWbName, TextToDisplay:="zum Auftrag"
          End With
        
        Workbooks(sWbName).Saved = True


        Workbooks(sWbName).Close


        iZeile = iZeile + 1


    End If

Next


End Sub

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot 2 Ordner auslesen
12.01.2021 07:16:31 Charles
Solved
12.01.2021 08:45:52 volti
Solved
12.01.2021 10:02:42 Gast43032
NotSolved