View Full Version : Method 'SaveAs' of object '_Workbook' failed

04-16-2019, 02:58 AM
Hi, my Code gives an error for the variable str_FileName in the line I have marked with "ERROR". If I replace this variable with a hard coded string like "String" then the code runs error-free.

Public Sub fkt_Copy()

Dim str_Path_Dest As String
Dim str_FileName As String
Dim str_DestPathName As String
Dim fnPos As Integer
Dim foFS As FileSystemObject
Dim bFileExists, bFileOpen As Boolean

Dim xApp As Excel.Application
Dim xWbk As Workbook
Dim ws As Worksheet
Dim fldr As FileDialog
Dim sItem As String

bFileExists = False
bFileOpen = False

On Error GoTo Err

Dim objShell
Dim strFileName As String
Dim strFilePath As String
Dim objFile As Object

Set objShell = CreateObject("Shell.Application")
Set objFile = objShell.BrowseForFolder(0, "Choose a folder:", &H1, 17)
If objFile Is Nothing Then Exit Sub

str_Path_Dest = objFile.Self.Path

Application.DisplayAlerts = False

str_FileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)

str_DestPathName = str_Path_Dest & "\" & str_FileName & "_output" & ".xlsm"

'Prüfen, ob Workbook offen ist
If Dir(str_DestPathName) <> "" Then
bFileExists = True
If Not IsFileOpen(str_DestPathName) Then
bFileOpen = False
End If
End If

If Not bFileOpen Or Not bFileExists Then
'kopieren falls Clone nicht offen ist oder noch nicht existiert
Set foFS = New Scripting.FileSystemObject
If Left(ThisWorkbook.FullName, 3) Like "*:\" Then
Call foFS.CopyFile(ThisWorkbook.FullName, str_DestPathName, True)
ActiveWorkbook.SaveCopyAs Filename:=str_DestPathName
End If

Set xApp = New Excel.Application
xApp.DisplayAlerts = False
xApp.EnableEvents = False

Set xWbk = xApp.Workbooks.Open(str_DestPathName, ReadOnly:=True)

For Each ws In xWbk.Worksheets
If ws.FilterMode Then
End If

ws.UsedRange.PasteSpecial xlPasteValues
Next ws

'Speichern des Clones als xlsx-File und schließen des Workbooks

xWbk.SaveAs str_Path_Dest & "\" & str_FileName & "_output", xlOpenXMLWorkbook <------- ERROR


xApp.EnableEvents = True
xApp.DisplayAlerts = True

'löschen der als xlsm kopierten Clone-Datei
Kill str_DestPathName
MsgBox "Kopie gespeichert"
MsgBox "Datei kann nicht kopiert werden. Zieldatei geöffnet"
End If
Exit Sub
MsgBox "Fehler bei Datei kopieren. " & Err.Description

'schließen des Workbooks bei Fehlern
If Not (xWbk Is Nothing) Then
xWbk.Close False
End If

If Not (xApp Is Nothing) Then
xApp.EnableEvents = True
xApp.DisplayAlerts = True
End If

Exit Sub

Application.DisplayAlerts = True

End Sub

04-16-2019, 09:28 PM

xWbk.SaveAs str_Path_Dest & "\" & str_FileName & "_output", xlOpenXMLWorkbook <------- ERROR

When I commented out the <------- ERROR, it worked here without any problem.


04-16-2019, 09:48 PM
You can add this code to try it out and see what msgbox shows.

MsgBox str_Path_Dest & "\" & str_FileName & "_output" '< -------Add
xWbk.SaveAs str_Path_Dest & "\" & str_FileName & "_output", xlOpenXMLWorkbook '< -------Error

I guess str_Path_Dest did not get the correct value because of "on error goto err" line.