Hardcoding VBA SaveAs Pfad?

Question

Ich habe einige VBA-Code online gefunden und habe Modifikationen für das gemacht, was ich brauche. Ich bin auf das eine Problem gestoßen, dass ich den Pfad ändern konnte. Ich hatte den Eindruck, dass:

CurrentFile = ThisWorkbook.FullName 

nennen würde, um die vollständigen Dateinamen einschließlich Pfad zurück, wo sie zur Zeit gespeichert, aber wenn ich den Code ausführen es auf meine/Dokumente geht (nicht, wo die Datei gespeichert werden). Gibt es einen Weg, den ich unten mit einem hartkodierten Pfad ändern kann?

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 

End Sub Code hier

Answer 1

nur ein kleines zwicken oder 2, um Ihren Code erhalten Sie zu beheben. Ich habe deinen alten Code kommentiert, damit du sehen kannst, was ich geändert habe. Sie möchten das Dateiformat beim Speichern nicht so festlegen, wie Sie es getan haben, da es Sie immer dann auffordert, wenn Kompatibilitätsprobleme mit der Änderung der Version auftreten. Lassen Sie das Feld leer und es wird nur die Version verwendet, in der sich das Blatt bereits befindet. Sie können das C: \ nach NewFile = so bearbeiten, wie Sie es brauchen, behalten Sie es einfach in Anführungszeichen.

Alternativ könnten Sie den Standardspeicherort für Excel ändern, obwohl das kein VBA-Update ist.

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 

Answer 2

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 

End If

Answer 3

wenn ich laufe den Code es zu meinem/Dokument geht (nicht dort, wo die Datei gespeichert werden)

Dies ist, weil Sie einen vollständig qualifizierten (vollständiger Pfad) nicht zur Verfügung gestellt haben Wenn Sie der Datei einen Namen gegeben haben, öffnet sich der Dialog mit dem Standardverzeichnis von \ Documents.

Ich bevorzuge das FileDialog Objekt anstelle der Application.GetSaveAsFileName Methode.

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