VBA 保存到映射驱动器上的 CurDir答案

【问题标题】：VBA Saving to CurDir on Mapped DriveVBA 保存到映射驱动器上的 CurDir
【发布时间】：2014-02-27 03:31:05
【问题描述】：

我创建了一个宏，需要进行一些调整，但无法找到某个部分的答案。根据用户输入的officename，它打开另存为对话框，并在文件的当前目录+今天的日期创建一个文件夹。当保存在本地时，这工作正常。当文件移动到映射驱动器时，另存为对话框打开到我的本地下载文件夹。我尝试了一些方法，但结果都一样。

当我调试并打印路径时，它是正确的。我相信问题出在我使用 FileSystemObject 和 ChDir 的方式上，尽管从我所读到的内容来看，它们应该可以正常使用它们的使用方式。完整的 sub 粘贴在下面。

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

【问题讨论】：

ChDir() 如果您尝试切换到的文件夹位于不同的驱动器上，则该文件夹不起作用 - 您需要先调用 ChDrive()。 techonthenet.com/excel/formulas/chdrive.php
就是这样！谢谢你。将添加更新的代码供其他人查看。

标签： excel vba

【解决方案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

【讨论】：