VBA 创建文件夹并在文件夹中另存为 pdf

Question

我是 VBA 的新手，有一个问题。

我得到了将文件保存到特定文件夹的帮助，但不允许我覆盖该文件。

Sub Autosave2()
Dim vDir
Dim strFileExists, pdfname, fileSaveName As String
Dim FSO

pdfname = ActiveSheet.Range("Q2")
vDir = "\Reports\Internal PO Log\PO pdf's\"
If Right(pdfname, 3) = "pdf" Then
    fileSaveName = vDir & pdfname
Else
    fileSaveName = vDir & pdfname & ".pdf"
End If
MsgBox fileSaveName
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(fileSaveName) Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileSaveName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        MsgBox "PDF File Saved (CentreSoft\Reports\Internal PO Log\PO pdf's)"
    Else
        MsgBox "THIS PO NUMBER ALREADY EXISTS"
    End If

End Sub

我现在需要创建一个同名文件夹 (Range("Q2")) 并将文件另存为新文件夹中的 pdf 文件（同名；本例中为 PO 编号）

如果文件夹已经退出，我还需要显示消息，从而阻止代码从运行进一步。

任何帮助将不胜感激谢谢

Answer 1

这是你想要的吗？

Sub Autosave2()

Dim vDir
Dim strFileExists, pdfname, fileSaveName As String
Dim separator As String: separator = Application.PathSeparator
Dim FSO

pdfname = ActiveSheet.Range("Q2")
vDir = "\Reports\Internal PO Log\" & pdfname

If Dir(vDir, vbDirectory) = "" Then
   'create folder
    MkDir vDir
Else
   MsgBox "The folder already exits thus blocking the code from running any further."
   Exit Sub
End If

If Right(pdfname, 3) = "pdf" Then
    fileSaveName = vDir & separator & pdfname
Else
    fileSaveName = vDir & separator & pdfname & ".pdf"
End If

'MsgBox fileSaveName

Set FSO = CreateObject("Scripting.FileSystemObject")

If Not FSO.FileExists(fileSaveName) Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fileSaveName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        MsgBox "PDF File Saved in " & vDir
    Else
        MsgBox "THIS PO NUMBER ALREADY EXISTS"
    End If

End Sub

Answer 2

我已经解决了:-)

Sub Autosave2()

Dim vDir
Dim strFileExists, pdfname, fileSaveName As String
Dim FSO
Dim FldrName As String

pdfname = ActiveSheet.Range("Q2")
FldrName = "\Reports\Internal PO Log\PO pdf's\" & pdfname & "\" & pdfname
vDir = "\Reports\Internal PO Log\PO pdf's\" & pdfname

If Dir(vDir, vbDirectory) = "" Then
        'continue
Else
        MsgBox "The folder already exits thus blocking the code from running any further."
        Exit Sub
End If

'create folder
MkDir vDir

If Right(pdfname, 3) = "pdf" Then
    fileSaveName = FldrName & ".pdf"
Else
    fileSaveName = FldrName & ".pdf"
End If

'MsgBox fileSaveName

Set FSO = CreateObject("Scripting.FileSystemObject")

If Not FSO.FileExists(fileSaveName) Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileSaveName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        MsgBox "PDF File Saved in " & vDir
    Else
        MsgBox "THIS PO NUMBER ALREADY EXISTS"
    End If

End Sub

不太确定它是否是最好的解决方法，但我创建了一个新的 FldrName 并将所有内容指向保存文件中的那个

非常感谢你让我走到这一步.....你帮了我大忙

VBA 创建文件夹并在文件夹中另存为 pdf

VBA to Create a Folder and Save as a pdf within the folder

pdf

directory

vba

save