Private Sub Document_New() 
 
    Dim pfad As String 
    Dim pfad_neu As String 
    Dim datei As String 
    Dim datei_save As String 
    Dim objFSO As Object 
    Dim wintest As String 
     
     
     
    pfad = Environ("USERPROFILE") 
    pfad = pfad & "\AppData\Roaming\Microsoft\Office\" 
    pfad_neu = "pfadzudatei\Word.officeUI" 
    datei = pfad & "Word.officeUI" 
    datei_save = datei & "_save" 
    wintest = "C:\Users\" 
     
     
    If LCase(wintest & Environ("USERNAME")) = LCase(Environ("USERPROFILE")) Then 
     
     
        
       Set objFSO = CreateObject("Scripting.fileSystemObject") 
    
       If Dir(datei) <> "" Then                      'Datei vorhanden -> kopieren ,löschen 
        
          If Dir(datei_save) <> "" Then 
             Kill (datei_save) 
          End If 
        
          objFSO.copyFile datei, datei_save 
          Kill (datei) 
              
       End If 
    
    
       objFSO.copyFile pfad_neu, datei 
     
    End If 
    
     
 
End Sub