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

Question

I'm trying to use VBA code to save an excel workbook with a specific file name based on cell data and in a specific network folder. Here's the code.

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

the file is just being saved in the H drive and not the testing folder in the H drive. Also, the activeworkbook line did have Filename:=Path & FileName1 etc. but it was saving in the same place with the name of the path end folder in front of "FileName1". Any advice here would be appreciated :) thank you.

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

Hi there Nhago'to and welcome to StackOverFlow community! I would like to suggest some tips when working with paths:

1. Create your folder before using it
2. Check that Range is filled with some text (specially with ranges)
3. Create the FileName argument in a separate string instead of inside the function (so it can be inspected before hand)

Here is an example of how you try this explained tips and for further projects! Good luck mate!

> Your code

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

> Auxiliar function to Create a folder path

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

> Auxiliar function to Check if folder path exists

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