如何使檔案夾路徑通用？

VBA 新手并有一項任務來創建一個子集，該子集從一個作業簿粘貼到新作業簿中。保存檔案的要求是“檔案夾路徑是通用的，以便其他人也可以創建此檔案夾”。我會對 ActiveWorkbook.SaveAs 方法做哪些修改來實作這一點？謝謝

Sub pasteTable()

    Dim formatting As Variant 'create variable to hold formatting2 workbook path
    formatting = Application.GetOpenFilename()  'user is prompted and selects path to formatting2 workbook and assigns to formatting variable
    
    Workbooks.Open formatting  'formatting2 workbook is now active
    Worksheets("Formatting").Range("B3:R13").Copy  'copies table from formatting2 workbook
    Workbooks.Add  'add new workbook
    
    Worksheets(1).Range("B3:R13").Select  'selects range on worksheet of new workbook to paste table
    Selection.PasteSpecial xlPasteAll 'pastes table
    
    Columns("B:R").ColumnWidth = 20  'ensures table has proper row and column heights/widths
    Rows("3:13").RowHeight = 25
    
    Worksheets(1).Name = "Table Data"  'renames worksheet
        
    ActiveWorkbook.SaveAs "C:\Users\name\Desktop\names Excel Assessment VBA\names Excel Assessment VBA " & Format(Date, "dd/mmm/yyyy"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
    'saves workbook according to desired specifications
End Sub

uj5u.com熱心網友回復：

將您的保存行更改為：

ActiveWorkbook.SaveAs "C:\Users\" & Environ("Username") & "\Desktop\Excel Assessment VBA\Excel Assessment VBA " & Format(Date, "dd-mmm-yyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

該Username系統變數將根據Windows帳戶正在使用調整。只需確保每個用戶的桌面上也存在這些檔案夾，否則您將收到錯誤訊息。我還names從檔案夾名稱中洗掉了，因為我假設您也在嘗試使用用戶名執行某些操作。您可以根據自己的需要進行調整。

您的日期格式也需要更改，因為它包含非法字符。

您還忘記包含檔案擴展名，因此我也添加了該擴展名。

這條線有很多事情要做，包括很多錯誤，所以你將不得不嘗試一下，直到你得到你需要的東西。您可能想稍微簡化一下，直到您掌握所有這些事情的竅門。

uj5u.com熱心網友回復：

我認為您必須添加更多檢查

該腳本需要 tool-path-folder 的名稱為 constant ToolFolder。

加上ToolBaseFolder可以設定為父路徑`ToolFolder的第二個常量，例如網路路徑。如果 const 為空，則將使用用戶桌面。

如果此路徑尚不存在，則會創建它。

Option Explicit

Private Const ToolBaseFolder As String = "" 'if ToolBaseFolder is an empty string desktop will be used instead
Private Const ToolFolder As String = "MyNameForToolFolder"


Public Sub testWbToToolFolder()
'this is just for testing
Dim wb As Workbook: Set wb = ActiveWorkbook
saveWbToToolFolder wb, "test.xlsx"
End Sub


Public Sub saveWbToToolFolder(wb As Workbook, filename As String)
'you don't need this sub - but have the same code line in your main routine
wb.SaveAs getToolFolder & filename
End Sub



Public Function getToolFolder() As String
'this returns the toolfolder e.g. C:\Users\xyz\Desktop\MyNameForToolFolder

Dim basepath As String
basepath = ToolBaseFolder & "\"

If existsFolder(basepath) = False Then
    If LenB(ToolBaseFolder) > 0 Then
        MsgBox ToolBaseFolder & " does not exist." & vbCrLf & _
            "File will be saved to " & ToolFolder & " on desktop ", vbExclamation
    End If
    basepath = getDesktopFolderOfUser
End If

Dim fullpath As String
fullpath = basepath & ToolFolder & "\"

If existsFolder(fullpath) = False Then
    makeFolder fullpath
End If

getToolFolder = fullpath

End Function


Private Function existsFolder(path As String) As Boolean
If Len(path) < 2 Then Exit Function 'can't be a valid folder
existsFolder = LenB(Dir(path, vbDirectory)) > 0
End Function

Private Function getDesktopFolderOfUser() As String
getDesktopFolderOfUser = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
End Function

Private Function makeFolder(path As String)
'https://stackoverflow.com/a/26934834/16578424 plus comment from rayzinnz
CreateObject("WScript.Shell").Run "cmd /c mkdir """ & path & """", 0, True
End Function

標籤：擅长 vba

上一篇：在Excel表中查找x值的重復行

下一篇：如何從filedialog.askopenfilename存盤資料？