Consulting

Results 1 to 3 of 3

Thread: Method 'SaveAs' of object '_Workbook' failed

  1. #1

    Method 'SaveAs' of object '_Workbook' failed

    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)
            Else
            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
                 ws.Unprotect
                If ws.FilterMode Then
                    ws.ShowAllData
                End If
                
                ws.UsedRange.Copy
                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
            xWbk.Protect
            
            xWbk.Close
            
            
            xApp.EnableEvents = True
            xApp.DisplayAlerts = True
            xApp.Quit
            
            'löschen der als xlsm kopierten Clone-Datei
            Kill str_DestPathName
            MsgBox "Kopie gespeichert"
        Else
            MsgBox "Datei kann nicht kopiert werden. Zieldatei geöffnet"
        End If
        Exit Sub
    Err:
        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
            xApp.Quit
        End If
        
        Exit Sub
        
    
    
     Application.DisplayAlerts = True
     
     
        
    End Sub

  2. #2
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    344
    Location
    @Cinema
    xWbk.SaveAs str_Path_Dest & "\" & str_FileName & "_output", xlOpenXMLWorkbook   <------- ERROR
    When I commented out the <------- ERROR, it worked here without any problem.


    --Okami

  3. #3
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    344
    Location
    @Cinema
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •