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