硬编码VBA另存为path？
我在网上发现了一些VBA代码，并对我所需要的进行了修改。 我遇到了能够改变path的一个问题。 我的印象是：
CurrentFile = ThisWorkbook.FullName 将callback完整的文件名称，包括当前保存的path，但是当我运行代码时，它会转到我的/文档（而不是保存文件的位置）。 有一种方法，我可以修改下面的硬编码path？
Sub SaveWorkbookAsNewFile() Dim ActSheet As Worksheet Dim ActBook As Workbook Dim CurrentFile As String Dim NewFileType As String Dim NewFile As String Dim NewFileName As String NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy") Application.ScreenUpdating = False ' Prevents screen refreshing. CurrentFile = ThisWorkbook.FullName NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _ "Excel Files 2007 (*.xlsx), *.xlsx," & _ "All files (*.*), *.*" NewFile = Application.GetSaveAsFilename( _ InitialFileName:=NewFileName, _ fileFilter:=NewFileType) If NewFile <> "" And NewFile <> "False" Then ActiveWorkbook.SaveAs filename:=NewFile, _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Set ActBook = ActiveWorkbook Workbooks.Open CurrentFile ActBook.Close End If Application.ScreenUpdating = True
在这里结束子代码
只需稍微调整一下你的代码就可以解决你的问题。 我评论了你的旧代码，所以你可以看到我改变了什么。 你不想在保存的时候指定文件格式，因为如果你这样做的话，它总会提示你关于更改版本的兼容性问题。 保留空白，它将默认为表单已经存在的版本。您可以在NewFile =之后编辑C：\，无论您需要什么，只要将其保留在引号中即可。
或者，您可以更改Excel的默认保存位置，虽然这不是一个VBA修复程序。
Option Explicit Sub SaveWorkbookAsNewFile() Dim ActSheet As Worksheet Dim ActBook As Workbook Dim CurrentFile As String Dim NewFileType As String Dim NewFile As String Dim NewFileName As String NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy") Application.ScreenUpdating = False ' Prevents screen refreshing. CurrentFile = ThisWorkbook.FullName 'NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _ ' "Excel Files 2007 (*.xlsx), *.xlsx," & _ ' "All files (*.*), *.*" NewFile = "C:\" & NewFileName 'NewFile = Application.GetSaveAsFilename( _ ' InitialFileName:=NewFileName, _ ' fileFilter:=NewFileType) If NewFile <> "" And NewFile <> "False" Then ActiveWorkbook.SaveAs Filename:=NewFile, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False ' ActiveWorkbook.SaveAs Filename:=NewFile, _ ' FileFormat:=xlNormal, _ ' Password:="", _ ' WriteResPassword:="", _ ' ReadOnlyRecommended:=False, _ ' CreateBackup:=False Set ActBook = ActiveWorkbook Workbooks.Open CurrentFile ActBook.Close End If Application.ScreenUpdating = True End Sub
If NewFile <> "" And NewFile <> "False" Then actsheet.SaveAs ("C:/HardcodedLocationHere.xlsx") ' if this fails, actbook FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Set ActBook = ActiveWorkbook Workbooks.Open CurrentFile ActBook.Close
万一
当我运行的代码它去我的/文件（不保存文件的位置）
这是因为你没有提供一个完整的（完整path）文件，你刚刚给了一个Name，所以它打开对话框的默认位置是\ Documents。
我更喜欢FileDialog对象而不是Application.GetSaveAsFileName方法。
Option Explicit Sub SaveWorkbookAsNewFile() Dim NewFile As String Dim NewFileName As String Dim fdlg as FileDialog NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy") Application.ScreenUpdating = False ' Prevents screen refreshing. Set fdlg = Application.FileDialog(msoFileDialogSaveAs) fdlg.InitialFileName = ThisWorkbook.Path & Application.PathSeparator & NewFileName fdlg.Show If fdlg.SelectedItems.Count <> 1 Then GoTo EarlyExit '# Gets the new file full path & name NewFile = fdlg.SelectedItems(1) ThisWorkbook.SaveCopyAs(NewFile) EarlyExit: Application.ScreenUpdating = True End Sub