Thema Datum  Von Nutzer Rating
Antwort
Rot Dringende Hilfe für die Bachelorarbeit
11.02.2019 10:02:47 Younes Ouis
NotSolved
11.02.2019 11:01:04 Gast52198
NotSolved
11.02.2019 13:55:06 Gast54476
NotSolved
11.02.2019 11:03:38 Gast21224
NotSolved
11.02.2019 11:07:36 Gast2918
NotSolved
11.02.2019 13:50:30 Gast78184
NotSolved
12.02.2019 04:35:47 Gast21224
NotSolved
11.02.2019 13:58:53 Gast12595
NotSolved
11.02.2019 14:00:40 Gast76002
NotSolved
11.02.2019 15:46:27 Ulrich
NotSolved
11.02.2019 17:01:38 Gast65786
NotSolved
11.02.2019 23:01:15 Ulrich
NotSolved
11.02.2019 17:21:55 Gast3333
NotSolved
11.02.2019 19:17:22 Ulrich
NotSolved
11.02.2019 19:19:35 Gast3333
NotSolved
12.02.2019 08:58:57 Younes Ouis
Solved
12.02.2019 09:00:41 Younes Ouis
NotSolved
11.02.2019 20:37:13 Younes Ouis
NotSolved
11.02.2019 21:34:24 Gast3333
NotSolved
11.02.2019 21:58:12 Gast3333
NotSolved
12.02.2019 04:25:27 Gast21224
NotSolved
12.02.2019 06:22:55 Gast01233
NotSolved

Ansicht des Beitrags:
Von:
Younes Ouis
Datum:
11.02.2019 10:02:47
Views:
192
Rating: Antwort:
  Ja
Thema:
Dringende Hilfe für die Bachelorarbeit
Guten Tag, 
ich habe mir diesen Code unten gebastelt und nur noch ein kleines Problem zu lösen. Für jede Hilfe wäre ich  sehr dankbar. 
Der Code kriegt es nicht hin "strFile = Dir(strPath & strExt)" zu speichern.
StrFile bleibt leer. Woran liegt das? 
 
Kleine erklärung zum programm: 
Dieses Programm ist zur statistischen Datenerfassung. Man gibt einen Pfad an, welcher nach xlsx dateien durchsucht wird. Die ganzen gefundenen Dateien werden zunächst als Pfade in dem Activeworksheet eingefügt. Darauf werden diese einzeln geöffnet, nach einem bestimmten worksheet durchsucht und falls es vorhanden ist, werden die daten in einem neuerstellten Worksheet eingefügt. Das ganze wird gelooped. 
 
 
 
 
Sub Mehrere_Dateien_einlesen()
    Dim strFile As String
    
    
    Dim i As Long
        
 'Opens All Subfolders and lists them in the Activeworksheet

 Dim fldr As FileDialog
 Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
 fldr.Show
 f = fldr.SelectedItems(1)
 f = f & "\"
 ibox = InputBox("File Must Contain (Note * wildcards can be used) ", , "*.xls*")
 On Error GoTo ext
 sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & f & ibox & """ /s /a /b").stdout.readall, vbCrLf)
 Sheets(1).Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)



ext:
    
    
For i = 1 To Rows.Count
    
    strPath = ThisWorkbook.Worksheets(1).Cells(i, 1) '  <--Enter Path here
    strExt = "*.xlsx" ' <-- Enter Data Type you want to open
    
    If strPath = "" Then
        Exit Sub
    Else
        strFile = Dir(strPath & strExt)
        Do While Len(strFile) > 0
            Workbooks.Open Filename:=strPath & strFile ' Opens File
                                
            
                 If BlattExist("Beutel(bag)") Then ' <-- Enter the Worksheet that includes the Data
                 
                        
                        Workbooks(strFile).Worksheets("Beutel(bag)").Range("B73,F73:I73,B90,F90:I90,B91,F91:I91").Copy '<-- Enter Cells that include the Data
                                                      
                         
                         'Shortens Filename if Name exceeds 31 Characters
                             If Len(strFile) > 0 Then
                              If Len(strFile) > 31 Then
                                 strFile = Left(strFile, 31)
                              End If
                             End If
                        
                        
                         MsgBox "Found Data copying will be done"
                        
                        
                        ThisWorkbook.Worksheets.Add.Name = strFile
                        'Fehler Ende
                        ThisWorkbook.Worksheets(strFile).Range("A1").PasteSpecial Paste:=xlValues
                        Application.CutCopyMode = False 'deletes the copy buffer
                        
              
                  Else
                   MsgBox "File doesnt include the wanted Data"
                  End If
                        
                
            Workbooks(strFile).Close False
                  
           strFile = Dir()
       
        Loop

    End If
    Next
End Sub

'Function of checking the existance of a Worksheet
Function BlattExist(strBlatt As String) As Boolean

Dim shDummy

   On Error Resume Next: Err.Clear
   Set shDummy = ActiveWorkbook.Sheets(strBlatt)
   If Err.Number = 0 Then
      BlattExist = True
   End If
End Function

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 Dringende Hilfe für die Bachelorarbeit
11.02.2019 10:02:47 Younes Ouis
NotSolved
11.02.2019 11:01:04 Gast52198
NotSolved
11.02.2019 13:55:06 Gast54476
NotSolved
11.02.2019 11:03:38 Gast21224
NotSolved
11.02.2019 11:07:36 Gast2918
NotSolved
11.02.2019 13:50:30 Gast78184
NotSolved
12.02.2019 04:35:47 Gast21224
NotSolved
11.02.2019 13:58:53 Gast12595
NotSolved
11.02.2019 14:00:40 Gast76002
NotSolved
11.02.2019 15:46:27 Ulrich
NotSolved
11.02.2019 17:01:38 Gast65786
NotSolved
11.02.2019 23:01:15 Ulrich
NotSolved
11.02.2019 17:21:55 Gast3333
NotSolved
11.02.2019 19:17:22 Ulrich
NotSolved
11.02.2019 19:19:35 Gast3333
NotSolved
12.02.2019 08:58:57 Younes Ouis
Solved
12.02.2019 09:00:41 Younes Ouis
NotSolved
11.02.2019 20:37:13 Younes Ouis
NotSolved
11.02.2019 21:34:24 Gast3333
NotSolved
11.02.2019 21:58:12 Gast3333
NotSolved
12.02.2019 04:25:27 Gast21224
NotSolved
12.02.2019 06:22:55 Gast01233
NotSolved