Question

我创建了一个需要调整但无法找到一个部分的答案的宏。根据officename的用户输入，它打开SaveAs对话框，并在文件的当前目录+今天的日期创建一个文件夹。在本地保存时，这很好用。将文件移动到映射的驱动器时，“另存为”对话框将打开到本地下载文件夹。我尝试过一些东西，但都有相同的结果。

当我调试并打印路径时，它是正确的。我相信问题在于我如何使用FileSystemObject和ChDir，尽管从我读过的内容中它们应该可以正常使用它们。完整的子被粘贴在下面。

Sub SaveAs()
Dim file_name As Variant
Dim xdir As String
Dim fso
Dim saveDate As String

Set fso = CreateObject("Scripting.FileSystemObject")
saveDate = Date
saveDate = Replace(saveDate, "/", ".")
'Debug.Print "Test" & " "; officeName <-- good
Fname = officename & " " & Date
Fname = Replace(Fname, "/", "-")
Debug.Print Fname <-- good
xdir = ThisWorkbook.Path & "\" & officename
Debug.Print xdir <-- good
If Not fso.FolderExists(xdir) Then
 fso.CreateFolder (xdir)
End If

ChDir (xdir)

' Get the file name.
file_name = Application.GetSaveAsFilename(Fname, _
    FileFilter:="Excel Macro-Enabled Workbook,*.xlsm,All Files,*.*", _
    Title:="Save As File Name")

' See if the user canceled.
If file_name = False Or "False.xls" Then Exit Sub

Answer 1

以下更新的代码现在可以在所有机器上正常运行！感谢您的投入！

ChDir（xdir）

Sub SaveAs()
Dim file_name As Variant
Dim xdir As String
Dim fso
Dim saveDate As String
Dim driveLetter As String <-- NEW VARIABLE    

Set fso = CreateObject("Scripting.FileSystemObject")
saveDate = Date
saveDate = Replace(saveDate, "/", ".")
'Debug.Print "Test" & " "; officeName <-- good
Fname = officename & " " & Date
Fname = Replace(Fname, "/", "-")
Debug.Print Fname <-- good
xdir = ThisWorkbook.Path & "\" & officename
Debug.Print xdir <-- good
If Not fso.FolderExists(xdir) Then
 fso.CreateFolder (xdir)
End If

////new code
driveLetter = Left(xdir, 1)
ChDrive (driveLetter)
////new code

ChDir (xdir)

' Get the file name.
file_name = Application.GetSaveAsFilename(Fname, _
FileFilter:="Excel Macro-Enabled Workbook,*.xlsm,All Files,*.*", _
Title:="Save As File Name")

' See if the user canceled.
If file_name = False Or "False.xls" Then Exit Sub

VBA在映射驱动器上保存到CurDir

1 个答案: