简体   繁体   中英

Excel Macro gets stuck in while loop

Ok so below is a code that takes pdfs from one location based on a visible cell range and then put them in a created directory and then calls another module to merge the pdfs. In the second module there is a variable strPath that when the full folder path is defined it works fine. However trying to use a structure like "..\\Submittal Packaged\\BOM PDF\\" it gets stuck in a while loop. I have debugged and watched it step through and find every pdf file in the folder but instead of not seeing the end it loops back to the beginning.

The below code is configured in the way I am having issues.

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

像在第一个模块中一样,将默认目录分配给Y:作为chdrive "y:\\"

I don't remember all the details but using DIR for directory lists can give different answers depending on its state. You may want to learn about the FileSystemObject for working with files and folders.

Here's an example of how to enumerate all files in a folder and its subfolders https://stackoverflow.com/a/36365535/183298

Here's an overview of how to work with the FileSystemObject in VBA: http://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM