尝试使用 VBA 和特定网络路径将 Excel 工作簿另存为

Question

我正在尝试使用 VBA 代码根据单元格数据和特定的网络文件夹保存具有特定文件名的 Excel 工作簿。 这是代码。

Private Sub CommandButton1_Click()
Dim Path As String
Dim FileName1 As String
Dim FileName2 As String
Path = "H:\testing folder\"
FileName1 = Range("A8")
FileName2 = Range("A11")
ActiveWorkbook.SaveAs Filename:=FileName1 & "_" & FileName2 & ".xlsx", FileFormat:=51
End Sub

该文件只是保存在H盘中，而不是H盘中的测试文件夹中。 此外，activeworkbook 行确实有 Filename:=Path & FileName1 等，但它与“FileName1”前面的路径结束文件夹的名称保存在同一个位置。 任何建议在这里将不胜感激:) 谢谢。

Answer 1

Private Sub CommandButton1_Click()
Dim Path As String
Dim FileName1 As String
Dim FileName2 As String
Path = "H:\testing folder\"
FileName1 = Range("A8")
FileName2 = Range("A11")
ActiveWorkbook.SaveAs Filename:=Path & FileName1 & "_" & FileName2 & ".xlsx", FileFormat:=51
End Sub

Answer 2

您好 Nhago'to，欢迎来到 StackOverFlow 社区！ 在使用路径时，我想提出一些提示：

1. 在使用之前创建您的文件夹
2. 检查范围是否填充了一些文本（特别是范围）
3. 在单独的字符串中而不是在函数内部创建 FileName 参数（因此可以事先对其进行检查）

这是一个示例，说明您如何尝试此解释的技巧以及进一步的项目！ 祝你好运！

> 你的代码

Private Sub CommandButton1_Click()

  Dim strPath As String
  Dim strFileName_ As String

    '(1. Create your folder before using it)
    'Create folders if necessary (Return path as String)
    strPath = Create_Path("H:\testing folder\")

    
    'Get range with File.Name
    Set Rng_ = Union(Range("A8"), Range("A11"))     'Each range should be filled only with names (without extension nor Path)
    Rng_.Select
    
    'Get FileName for each Range
    For Each text_ In Rng_
        '(2. Check that Range is filled with some text (specially with ranges))
        If Len(text_) = 0 Then Err.Raise 100, , "There is no text in range"

         '(3. Create the FileName argument in a separate string instead of inside the function (so it can be inspected before hand))
        strFileName_ = strPath & text_
        
        'Save as xlOpenXMLWorkbook = 51
        ActiveWorkbook.SaveAs FileName:=strFileName_, FileFormat:=xlOpenXMLWorkbook
        'Check other FileFormat Constants at: https://docs.microsoft.com/en-us/office/vba/api/excel.xlfileformat
    Next

End Sub

> 创建文件夹路径的辅助功能

Function Create_Path(ByVal strPath As Variant) As String

  Dim arrFolders As Variant
  Dim strNewFolder As String
  Dim i As Long
  
    'Set variables
    strPath = Split(strPath, ".")(0)                            'Splits strPath to ignore extensions i.e: .exe, .zip
    arrFolders = Split(Split(strPath, ":")(1), "\")             'Splits strPath as several folder's names
    strDriver = Split(strPath, ":")(0) & ":"                    'Gets driver letter in strPath (hard disk letter)

    'Check if whole strPath already exists
    If Dir(strPath, vbDirectory) = "" Then                      'Tests if dir is already created
    
        'Create each folder
        For i = 1 To UBound(arrFolders)
            strNewFolder = strDriver & "\" & arrFolders(i)   'Sets a new folder name
            
            'Check if this folder is already created
            If Not FolderExists(strNewFolder) Then
                MkDir strNewFolder                              'Create a folder
            End If
        Next
        
    End If

    'Fill function variable
    Create_Path = strPath

End Function

> 检查文件夹路径是否存在的辅助功能

Function FolderExists(ByVal strFolder As String, Optional bRaiseError As Boolean) As Boolean

  Dim fso As Object
  
    'Create FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")

    'Alert user that strFolder is not an String
    If TypeName(strFolder) <> "String" Then
        Err.Raise 100, "", "Function FolderExists:" & " variable strFolder is not an String"
    End If
    
    'Check if folder exists
    bExists = fso.FolderExists(strFolder)
    
    'Fill function variable
    FolderExists = bExists
    
    'Alert user that this folder does not exist (Case bRaiseError = True)
    If (bRaiseError And FolderExists = False) Then Err.Raise 100, "", "Function FolderExists: strFolder does not exist"

End Function