使用Visual Basic在Excel中创建文件夹目录

Question

我是Visual Basic的新手

我目前正在尝试在Excel中创建一个计算器，我可以将数据导出到PDF中。我已经能够导出excel文件，但它只会转到我的“D：\”。

如何在D：\中创建一个文件夹，称为Excel_Calculator，我可以将创建的所有PDF文件直接保存到该文件夹​​中。如果已有一个名为“Excel_Calculator”的文件夹使用该文件夹而不是覆盖现有文件夹。

这里列出了我保存PDF的代码：

Sub GetFilenameForPDF()
Dim strFileName As String, strB1 As String, strWorksheet As String


strB1 = Range("B1").Value
strWorksheet = ActiveSheet.Name
strFileName = strB1 & " " & strWorksheet & " " & Format(Date, "DD-MM-YYYY")




Sub SaveToPDF()

Dim strFileName As String, strC3 As String, strWorksheet As String
strB1 = Range("B1").Value
strWorksheet = ActiveSheet.Name
strFileName = strB1 & " " & strWorksheet & " " & Format(Date, "DD-MM-YYYY")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "D:\" & strFileName & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=True
    End Sub

**编辑：或者有没有办法我可以创建文件或将文件重定向到临时位置，以便文件夹不会堵塞，用户可以在需要时打印/保存PDF？**

Answer 1

我更喜欢使用FileSystemObject

在您的VBA项目中，单击Toos-> References并添加“Microsoft Scripting Runtime”。

然后，在您的代码中，执行以下操作：

Dim fso as FileSystemObject
Dim folderName as String

Set fso = new FileSystemObject
folderName = "D:\MyFolder"
If fso.FolderExists(folderName) = false then
    fso.CreateFolder folderName
End If

Dim strFileName As String, strC3 As String, strWorksheet As String
strB1 = Range("B1").Value
strWorksheet = ActiveSheet.Name
strFileName = folderName + "\" + strB1 & " " & strWorksheet & " " & Format(Date, "DD-MM-YYYY")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\" & strFileName & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True

Answer 2

您可以使用以下函数创建单个文件夹或子文件夹树。该函数使用（VBA.FileSystem）MkDir函数。

Public Function CreateFolderTree(ByVal mainFolder As String, ParamArray args() As Variant) As String
    On Error GoTo ErrProc

    Dim path As String
        path = mainFolder & IIf(Right(mainFolder, 1) <> "\", "\", vbNullString)

    Dim idx As Long
    For idx = LBound(args) To UBound(args)
        If Len(Dir(path & args(idx), vbDirectory)) = 0 Then MkDir path & args(idx)
        path = path & args(idx) & "\"
    Next idx

    CreateFolderTree = path

Leave:
    On Error GoTo 0
    Exit Function

ErrProc:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Function

打电话给它：

Sub T()
    Dim path_ As String
        path_ = CreateFolderTree("C:\My folder", "Subfolder 1", "Subfolder 2")

    Debug.Print path_

    'C:\My folder\Subfolder 1\Subfolder 2\
End Sub

Answer 3

我通常使用这个：

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Public Sub MakeFullDir(strPath As String)
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Optional depending upon intent
  MakeSureDirectoryPathExists strPath
End Sub

如果该路径尚不存在，则即使存在多层不存在的文件夹，也会创建该路径。

例如：C：\ aFolder \ Folder \ c Folder \如果只存在aFolder，则会生成文件夹和文件夹。