Код VBA для открытия всех файлов excel в папке

Question

Я работал с vba, и я пытаюсь открыть все файлы excel в папке (около 8-10) на основе значений ячеек. Мне было интересно, если это правильный подход к его открытию, он продолжает давать синтаксическую ошибку, когда я писал каталог. и когда я переписал этот раздел, vba только выстрелил из msgbox, что означало, что он должен был зациклиться и что-то сделать правильно? но не открывал никаких файлов. Любая информация поможет. Спасибо, ребята, за то, что нашли время, чтобы помочь мне в любом случае.

Sub OpenFiles() 

Dim search As Worksheet 
Dim customer As Range 
Dim customerfolder As Range 

Dim QualityHUB As Workbook 

'setting variable references 
Set QualityHUB = ThisWorkbook 
Set search = Worksheets("Search") 
Set customer = Worksheets("Search").Range("$D$1") 
Set customerfolder = Worksheets("Search").Range("$D$3") 


With QualityHUB 

If IsEmpty((customer)) And IsEmpty((customerfolder)) Then 

MsgBox "Please Fill out Customer Information and search again" 

Exit Sub 

End If 

End With 

With QualityHUB 


Dim MyFolder As String 
Dim MyFile As String 
Dim Directory As String 

Directory = "O:\LAYOUT DATA\" & customer & "\" & customerfolder" 


MyFile = Dir(Directory & "*.xlsx") 


Do While MyFile <> "" 

Workbooks.Open Filename:=MyFile 

MyFile = Dir() 


Loop 


MsgBox "Files Open for " + customerfolder + " complete" 


End With 


End Sub 

Answer 1

Это работал для меня совершенно

Sub OpenFiles() 

Dim search As Worksheet 
Dim customer As Range 
Dim customerfolder As Range 

Dim QualityHUB As Workbook 

'setting variable references 
Set QualityHUB = ThisWorkbook 
Set search = Worksheets("Search") 
Set customer = Worksheets("Search").Range("$D$1") 
Set customerfolder = Worksheets("Search").Range("$D$3") 


With QualityHUB 

If IsEmpty((customer)) And IsEmpty((customerfolder)) Then 

    MsgBox "Please Fill out Customer Information and search again" 

Exit Sub 

End If 

End With 

With QualityHUB 


Dim MyFolder As String 
Dim MyFile As String 
Dim Directory As String 

Directory = "O:\LAYOUT DATA\" & customer & "\" & customerfolder & "\" 


MyFile = Dir(Directory & "*.xlsx") 

Do While MyFile <> "" 

Workbooks.Open Filename:=Directory & MyFile 

MyFile = Dir() 


Loop 


MsgBox "Files Open for " + customerfolder + " complete" 


End With 


End Sub 

один из этот вопрос, вы должны были написать

Workbooks.Open Filename:=Directory & MyFile 

вместо

Workbooks.Open Filename:=MyFile 

Answer 2

Я нашел этот код на сайте, и он будет открывать все файлы первенствовать в папке, вы можете адаптировать код, чтобы применить функцию к книге, когда она открыта.

Option Explicit 

Type FoundFileInfo 
    sPath As String 
    sName As String 
End Type 

Sub find() 
Dim iFilesNum As Integer 
Dim iCount As Integer 
Dim recMyFiles() As FoundFileInfo 
Dim blFilesFound As Boolean 

blFilesFound = FindFiles("G:\LOCATION OF FOLDER HERE\", _ 
     recMyFiles, iFilesNum, "*.xlsx", True) 
End Sub 

Function FindFiles(ByVal sPath As String, _ 
    ByRef recFoundFiles() As FoundFileInfo, _ 
    ByRef iFilesFound As Integer, _ 
    Optional ByVal sFileSpec As String = "*.*", _ 
    Optional ByVal blIncludeSubFolders As Boolean = False) As Boolean 
    Dim iCount As Integer   '* Multipurpose counter 
    Dim sFileName As String   '* Found file name 
    Dim wbResults, file, WS_Count, i, gcell, col, finRow, wbCodeBook As Workbook, lCount, name, looper 
    Dim WorksheetExists 
    Set wbCodeBook = ThisWorkbook 

    '* 
    '* FileSystem objects 
    Dim oFileSystem As Object, _ 
     oParentFolder As Object, _ 
     oFolder As Object, _ 
     oFile As Object 

    Set oFileSystem = CreateObject("Scripting.FileSystemObject") 
    On Error Resume Next 
    Set oParentFolder = oFileSystem.GetFolder(sPath) 
    If oParentFolder Is Nothing Then 
     FindFiles = False 
     On Error GoTo 0 
     Set oParentFolder = Nothing 
     Set oFileSystem = Nothing 
     Exit Function 
    End If 
    sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\") 
    '* 
    '* Find files 
    sFileName = Dir(sPath & sFileSpec, vbNormal) 
    If sFileName <> "" Then 
     For Each oFile In oParentFolder.Files 
      If LCase(oFile.name) Like LCase(sFileSpec) Then 
       iCount = UBound(recFoundFiles) 
       iCount = iCount + 1 
       ReDim Preserve recFoundFiles(1 To iCount) 
       file = sPath & oFile.name 
       name = oFile.name 
      End If 
       On Error GoTo nextfile: 
       Set wbResults = Workbooks.Open(Filename:=file, UpdateLinks:=0) 


''insert your code here 


       wbResults.Close SaveChanges:=False 
nextfile: 
     Next oFile 
     Set oFile = Nothing   '* Although it is nothing 
    End If 
    If blIncludeSubFolders Then 
     '* 
     '* Select next sub-forbers 
     For Each oFolder In oParentFolder.SubFolders 
      FindFiles oFolder.path, recFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders 
     Next 
    End If 
    FindFiles = UBound(recFoundFiles) > 0 
    iFilesFound = UBound(recFoundFiles) 
    On Error GoTo 0 
    '* 
    '* Clean-up 
    Set oFolder = Nothing   '* Although it is nothing 
    Set oParentFolder = Nothing 
    Set oFileSystem = Nothing 

End Function 
Function SSCGetColumnCodeFromIndex(colIndex As Variant) As String 
    Dim tstr As String 
    Dim prefixInt As Integer 
    Dim suffixInt As Integer 
    prefixInt = Int(colIndex/26) 
    suffixInt = colIndex Mod 26 
    If prefixInt = 0 Then 
     tstr = "" 
    Else 
     prefixInt = prefixInt - 1 
     tstr = Chr(65 + prefixInt) 
    End If 
    tstr = tstr + Chr(65 + suffixInt) 
    SSCGetColumnCodeFromIndex = tstr 
End Function 
Function GetColNum(oSheet As Worksheet, name As String) 
Dim Endrow_Col, i 
'For loop to get the column number of name 
Endrow_Col = oSheet.Range("A1").End(xlToRight).Column 
oSheet.Select 
oSheet.Range("A1").Select 
For i = 0 To Endrow_Col - 1 Step 1 
If ActiveCell.Value <> name Then 
    ActiveCell.Offset(0, 1).Select 
ElseIf ActiveCell.Value = name Then 
    GetColNum = ActiveCell.Column 
    Exit For 
    End If 
Next i 
End Function 
Function ShDel(name As String) 

End If 
End Function 

Answer 3

Исправлены некоторые проблемы с кодом и его очистка, попробуйте. Я думаю, что большой вопрос вы имели дополнительные двойные кавычки, и отсутствует окончание \ в каталоге строки:

Sub OpenFiles() 

    Dim QualityHUB As Workbook 
    Dim search As Worksheet 
    Dim customer As String 
    Dim customerfolder As String 
    Dim Directory As String 
    Dim MyFile As String 

    'setting variable references 
    Set QualityHUB = ThisWorkbook 
    Set search = QualityHUB.Worksheets("Search") 
    customer = search.Range("$D$1").Value 
    customerfolder = search.Range("$D$3").Value 

    If Len(Trim(customer)) = 0 Or Len(Trim(customerfolder)) = 0 Then 
     MsgBox "Please Fill out Customer Information and search again" 
     Exit Sub 
    End If 


    Directory = "O:\LAYOUT DATA\" & customer & "\" & customerfolder & "\" '<--- This requires the ending \ 
    MyFile = Dir(Directory & "*.xlsx") 

    Do While Len(MyFile) > 0 
     Workbooks.Open Filename:=Directory & MyFile 
     MyFile = Dir() 
    Loop 

    MsgBox "Files Open for " + customerfolder + " complete" 

End Sub