per Makro Laufwerk wählen und speichern

Question

Hallo Helfer,
ich muss zeitweilig einen PC nutzen, an dem (vom SysAdmi) div. unsinnige Einstellungen vorgenommen worden sind. u.a. lassen sich bei "speichern unter" keine USB-LW auswählen. Das nächste Makro funktioniert, aaaber

Sub FileSaveAs()
On Error Resume Next
ActiveDocument.SaveAs FileName:="F:\Speichern_in_F.doc"
On Error Resume Next
ActiveDocument.SaveAs FileName:="G:\Speichern_in_G.doc"
End Sub

wie kann ich folgendes Makro in das obige einbinden:

Sub LW_Test()
Dim strLW As String
Dim i As Long
On Error Resume Next
For i = Asc("C") To Asc("Z")
ChDrive Chr(i)
If Err = 0 Then strLW = strLW & Chr(i) & ", "
Err = 0
Next
On Error GoTo 0
MsgBox strLW, , "vorhandene Laufwerke"
End Sub

so das ich per:

Dialogs(wdDialogFileSaveAs).Show

das Laufwerk auswählen kann.

ActiveDocument.Name

sollte dort vorgegeben sein.
Vielen Dank im Voraus
mfg
Wolfgang

Answer 1

Hallo Wolfgang,

ich hoffe, ich habe dich richtig verstanden:

Sub speichern()
Dim Fs
Dim lw
Dim arrLW(25), strLW, LWText, LWspeichern, Pfadvorgaben As String
Dim i, z As Long
Dim exist As Boolean

'Laufwerksbuchstaben suchen
Set Fs = CreateObject("Scripting.filesystemobject")
For Each lw In Fs.drives
If lw.isready Then
arrLW(z) = lw
z = z + 1
End If
Next

'Laufwerke in Textvariable schreiben
For i = 0 To z - 1
strLW = strLW & arrLW(i) & ","
Next i

'Anzeigetext für die Inputbox
LWText = "Bitte wählen Sie ein entsprechendes Laufwerk aus: " & strLW

'Inputbox zur Eingabe des Laufwerksbuchstaben
LWspeichern = InputBox(LWText, "Eingabe")

'eingegebenen Laufwerksbuchstabe in Großschreibung umwandeln
LWspeichern = StrConv(LWspeichern, vbUpperCase)

'Prüfen, ob eingegebener Laufwerksbuchstabe mit gefundenen Laufwerken übereinstimmt
For i = 0 To z - 1
If InStr(arrLW(i), LWspeichern) > 0 Then
exist = True
Exit For
Else
exist = False
End If
Next i

'Falls nein, dann Abbruch des Makros
If exist = False Then
MsgBox "Das ausgewählte Laufwerk " & LWspeichern & " existiert nicht!", 0, "Fehler - Abbruch!"
Exit Sub
End If

'Pfad und Name des Dokuments in Variable für den Speichern-unter-Dialog schreiben
Pfadvorgabe = LWspeichern & ":\" & ActiveDocument.Name

'Speichern-unter-Dialog aufrufen
With Dialogs(wdDialogFileSaveAs)
.Name = Pfadvorgabe
.Show
End With

End Sub

Gruß

M.O.

Answer 2

Guten Morgen M.O.,
vielen Dank.
ich habe den Makronamen in "FileSaveAs()" geändert und es in der Normal.dot gespeichert, nun wird es durch anwählen on "Speichern unter..." automatisch ausgeführt.
Da das so gut funktioniert, hätte ich gerne das Gleiche auch in Excel.
Die Datei "PERSONAL.xls" gibt es schon.
Makroname "Sub Workbook_SaveAs()" ??
ActiveDocument.Name ändern in ActiveWorkbook.Name
With Dialogs(wdDialogFileSaveAs)? Muss wie heissen?

mfg
Wolfgang

Answer 3

Hallo Wolfgang,

in Excel musst du

'Pfad und Name des Dokuments in Variable für den Speichern-unter-Dialog schreiben
Pfadvorgabe = LWspeichern & ":\" & ThisWorkbook.Name

Application.Dialogs(xlDialogSaveAs).Show Pfadvorgabe

nutzen.

Gruß

M.O.

Answer 4

Hallo Wolfgang,

nochmal ich :-).

Natürlich musst du ActiveWorkbook.Name nutzen, wenn du das Makro in der Peronal.xls abspeicherst.

Gruß

M.O.

Answer 5

Hallo M.O.,
Heute habe ich wohl keine Zeit mehr, werde es Morgen ansehen, aber das wirds wohl sein.
Vielen Dank
mfg
Wolfgang