Function funcIsTasteGedrückt(iTastenCode As Integer) As Boolean  
' Überprüft Bit-weise, ob eine Taste gedrückt ist  
  Debug.Print GetKeyState(iTastenCode)
  If (GetKeyState(iTastenCode) And &HF000&) = &HF000& Then
    funcIsTasteGedrückt = True
  End If
End Function  

Sub DateiSpeichernUnter()  
' wird die Strg/Control-Taste beim Anklicken des Menüs "DateiSpeichernUnter"
' gedrückt gehalten, wird ein Backup der Datei im BackUp-Ordner angelegt  
Dim strFile As String
Dim strPath As String
Dim oDoc As Document
   On Error GoTo DateiSpeichernUnter_Error
Set oDoc = ActiveDocument
Dim strFolder As String
Dim ret As Single
If Documents.Count = 0 Then Exit Sub  
If funcIsTasteGedrückt(VK_CONTROL) = False Or funcIsTasteGedrückt(VK_SHIFT) = False Then
  Dialogs(wdDialogFileSaveAs).Show
Else
  ' Ordner auslesen  
  strFolder = fkt_ReadRegEntry
'CommandBars("Standard").FindControl(msoControlButton,1,"BrowseFolder").Caption 
  MsgBox "Es wird ein Datei-Backup im folgenden Ordner erstellt:" & vbCrLf & strFolder, _
    vbInformation, c_Title
  With Dialogs(wdDialogFileSaveAs)
    ret = .Show
    ' Name und Pfad der Datei auslesen  
    strFile = .Name
    strPath = CurDir
    If ret = -1 Then
      fkt_SaveBackType strFolder, strFile, oDoc
    ' eigentliche Datei im ausgewählten Ordner/Namen speichern  
      Select Case oDoc.Type
      Case wdTypeDocument
        oDoc.SaveAs strPath & "\" & strFile, wdFormatDocument
      Case wdTypeTemplate
        oDoc.SaveAs strPath & "\" & strFile, wdFormatTemplate
      End Select
    End If
  End With
End If
   On Error GoTo 0
   Exit Sub  
DateiSpeichernUnter_Error:
  MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure " & _
    "DateiSpeichernUnter of Modul SpeichernBak"
End Sub