Erstmal Danke, Ihr seit fantastisch.
Folgendes:
eine Mappe wird, beim Abspeichern immer auf einem Server abgelegt.
Nun, versuche ich, einen 'button' einzubauen, (kleines Backup) der folgendes kann.
1)
Abfrage, welches USB-Laufwerk, Stick usw. auf diesem PC, angeschlossen und beschreibbar ist.
2)
Ausgabe in einem Fenster das dieses(e) Laufwerk(e) auswählbar macht um die offene Datei (Mappe) zu speichern.
3)
Möglichkeit den Namen, Datum mit Uhrzeit zu ändern.
Das Einzige was ich habe ist folgendes:
ActiveWorkbook.SaveAs "d:\Excel\termine " & Format(Now, "yyyy.mm.dd") & ".xlsm"
Wer kann mir einen Tipp geben oder wer hat schon mal so ein Makro geschrieben und kann mir aushelfen?
Hallöchen,
USB-Laufwerke könntest Du im Prinzip so ausgeben. Kann aber auch SD-Kartenleser erwischen
Code:
Sub ShowDriveList
Dim objFSO as Object, objDrive as Object, objDrives as Object
Dim strAll$
'Objektzuweisung
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDrives = objFSO.Drives
'Schleife ueber alle Laufwerke
For Each objDrive in objDrives
'Wenn es ein Wechseldatentraeger ist, dann
If objDrive.DriveType = 2 Then
'LaufwerksName zum Ausgabestring hinzufuegen
strAll = strAll & objDrive.DriveLetter & vblf
'Ende Wenn es ein Wechseldatentraeger ist, dann
End If
'Ende Schleife ueber alle Laufwerke
Next
MsgBox strAll
End Sub
... Edit: SSD's werden auch als Wechseldatenträger erkannt.
Hallo,
im Bild (Anhang) werden alle HD's aufgelistet die im PC vorhanden sind.
Mein Wunsch währe dass nur die USB Lwerke angezeigt, die Partionen-Namen erscheinen,
anwählbar sind um darauf dann die Mappe, mit Name,als xls oder xlsm und Datum mit Uhrzeit, durch einen OK klicke zu speichern sind.
Das Problem ist dass die Benutzer der Mappe, von Computer weniger verstehen als ich
und deswegen die Sache so einfach wie möglich zu gestalten ist.
Merci
Verwende das serialnumber
Code:
Sub M_snb()
With CreateObject("scripting.filesystemobject")
For Each it In .drives
If it.SerialNumber = 12345 Then Exit For
Next
End With
MsgBox it
End Sub
Hallöchen,
nimm mal den DriveType 1 ...
Danke Leute,
aber ich komme nicht klar.
Ich gebs auf.
Hallöchen,
also, 2 durch 1 zu ersetzen sollte doch nicht so schwer sein.
Code:
Sub ShowDriveList()
Dim objFSO As Object, objDrive As Object, objDrives As Object
Dim strAll$
'Objektzuweisung
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDrives = objFSO.Drives
'Schleife ueber alle Laufwerke
For Each objDrive In objDrives
'Wenn es ein Wechseldatentraeger ist, dann
If objDrive.DriveType = 1 Then
'LaufwerksName zum Ausgabestring hinzufuegen
strAll = strAll & objDrive.DriveLetter & " " & objDrive.rootfolder.Type & " " & objDrive.volumename & vbLf
'Ende Wenn es ein Wechseldatentraeger ist, dann
End If
'Ende Schleife ueber alle Laufwerke
Next
MsgBox strAll
End Sub
Wenn das passt, kann man weitermachen ...
Lass mal laufen und zeige mal das Ergebnis:
Code:
Sub M_snb()
With CreateObject("scripting.filesystemobject")
For Each it In .drives
c00=c00 & vblf & it & vbtab & it.SerialNumber
Next
End With
msgbox c00
End Sub
@snb,
Dein Code zeigt alle Drives, mein letzter nur die Wechseldatenträger - z.B. USB-Drives, die als solche erkannt werden, also ggf. keine HD / SSD am USB-Port.
[
attachment=45658]
E ist eine SSD an USB, D und F zwei Sticks.
@Schau
Ich berücksichtige das Serialnumber; Der TS kann uns dann sagen welche Driveletterder USB hat.
Basiert auf das Ergebnis kann man wählen welche USB benützt werden soll.
z. B D:\
Code:
Sub M_snb()
With CreateObject("scripting.filesystemobject")
For Each it In .drives
If it.SerialNumber = 785958618 Then Exit For
Next
End With
activeworkbook.saveas it & "Beispiel.xlsb",50
End Sub