Excel-Makro wird in while-Schleife stecken

Question

Ok unten ist ein Code, der pdfs von einem Speicherort basierend auf einem sichtbaren Zellbereich nimmt und sie dann in einem erstellten Verzeichnis und ruft dann ein anderes Modul zum Zusammenführen der PDFs. Im zweiten Modul gibt es eine Variable strPath, die, wenn der vollständige Ordnerpfad definiert ist, funktioniert. Wenn Sie jedoch versuchen, eine Struktur wie ".. \ Submit Packaged \ BOM PDF \" zu verwenden, bleibt sie in einer while-Schleife stecken. Ich habe debugged und sah es durch Schritt und finden Sie jede pdf-Datei in den Ordner, aber anstatt das Ende nicht zu sehen, springt es zum Anfang zurück.

Der folgende Code ist so konfiguriert, wie ich Probleme habe.

Option Explicit ' Force variable declaration 
Public Const PDF_WILDCARD = "*.pdf" 
Public Const JOIN_FILENAME = "MASTER BOM.pdf" 
Public Sub CopyFile2() 
    ChDrive "y:" 
    ChDir ThisWorkbook.Path 
    MkDir ("..\Submittal Packaged\BOM PDF\") 
    Dim rng As Range 
    Const strNewDir As String = "..\Submittal Packaged\BOM PDF\" 

    For Each rng In Range("L9:L1042").SpecialCells(xlCellTypeVisible) 
     If CBool(rng.Hyperlinks.Count) Then 
      With rng.Hyperlinks(rng.Hyperlinks.Count) 
       If CBool(InStr(.Address, Chr(92))) Then 
        If Dir(strNewDir & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))) = "" Then 
         FileCopy .Address, _ 
         strNewDir & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92))) 
        Else 
         FileCopy .Address, _ 
         strNewDir & rng.Row & "-" & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92))) 
        End If 
       Else 
        If Dir(strNewDir & .Address) = "" Then 
         FileCopy .Address, _ 
         strNewDir & .Address 
        Else 
         FileCopy .Address, _ 
         strNewDir & rng.Row & "-" & .Address 
        End If 
       End If 
      End With 
     End If 
    Next rng 
Call mergepdf 
End Sub 

Sub mergepdf() 
    Dim AcroExchApp As Object, AcroExchPDDoc As Object, _ 
     AcroExchInsertPDDoc As Object 
    Dim strFileName As String, strPath As String 
    Dim iNumberOfPagesToInsert As Integer, _ 
     iLastPage As Integer 
    Set AcroExchApp = CreateObject("AcroExch.App") 
    Set AcroExchPDDoc = CreateObject("AcroExch.PDDoc") 


' Set the directory/folder to use 
    strPath = "..\Submittal Packaged\BOM PDF\" 

' Get the first pdf file in the directory 
    strFileName = Dir(strPath + PDF_WILDCARD, vbNormal) 

' Open the first file in the directory 
    AcroExchPDDoc.Open strPath + strFileName 

' Get the name of the next file in the directory [if any] 
    If strFileName <> "" Then 
     strFileName = Dir 

    ' Start the loop. 
     Do While strFileName <> "" 

    ' Get the total pages less one for the last page num [zerobased] 
      iLastPage = AcroExchPDDoc.GetNumPages - 1 
      Set AcroExchInsertPDDoc = CreateObject("AcroExch.PDDoc") 

     ' Open the file to insert 
      AcroExchInsertPDDoc.Open strPath + strFileName 

     ' Get the number of pages to insert 
      iNumberOfPagesToInsert = AcroExchInsertPDDoc.GetNumPages 

     ' Insert the pages 
     AcroExchPDDoc.InsertPages iLastPage, AcroExchInsertPDDoc, 0, iNumberOfPagesToInsert, True 

     ' Close the document 
      AcroExchInsertPDDoc.Close 

     ' Get the name of the next file in the directory 
      strFileName = Dir 
      Loop 

    ' Save the entire document as the JOIN_FILENAME using SaveFull 
[0x0001 = &H1] 
     AcroExchPDDoc.Save &H1, strPath + JOIN_FILENAME 

End If 

' Close the PDDoc 
    AcroExchPDDoc.Close 

' Close Acrobat Exchange 
    AcroExchApp.Exit 
End Sub 

Answer 1

zuordnen Standardverzeichnis zu Y: wie chdrive "y:\" wie im ersten Modul hat

Answer 2

Ich erinnere mich nicht alle Details, aber für Verzeichnislisten DIR mit unterschiedlichen Antworten geben kann auf seinen Zustand abhängig. Möglicherweise möchten Sie etwas über das FileSystemObject für die Arbeit mit Dateien und Ordnern erfahren.

Hier ist ein Beispiel dafür, wie alle Dateien in einem Ordner und dessen Unterordner aufzuzählen https://stackoverflow.com/a/36365535/183298

Hier ein Überblick darüber, wie mit dem Filesystem in VBA arbeiten: http://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/