Datei mit Excel doppelt speichern

Question

hallo,
ich habe mal wieder ein kleines problem. ich möchte beim speichern der exceltabelle diese automatisch in ein verzeichniss auf lw D: excel und gleichzeitig auf meinem usb stick speichern. wobei der stick ja nicht immer den gleichen lw buchstaben zugewiesen bekommt.
vieleicht kann mir jemand bei der lösung dieses problems helfen.
vielen dank im vorraus

dieter

Answer 1

Hallo Dieter,

das geht nur aufwendig über VBA. Ich hätte Dir dort ein Dialog angezeigt wo Du Dein Usb Stick auswählen kannnst.

Gruß Hajo

Answer 2

danke hayo,
das habe ich fast gedacht das es keine einfache lösung gibt.
dank trotzdem

gruß dieter

Answer 3

Hallo,
dieses problem interessiert mich auch. ist der programmier aufwand gross oder kann ein versierter exceluser das nicht doch hin bekommen. könntet ihr die lösung vieleicht mal zeigen.

MfG otto

Answer 4

Hallo Otto,

der Aufwand ist für einen erfahrenen User nicht hoch. Es ist nur viel Code notwendig.
Aber die Lösung per VBA wurde ja abgelehnt.
Unter DieseArbeitsmappe

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
StOrdner = GetAOrdner
ThisWorkbook.SaveCopyAs StOrdner & ThisWorkbook.Name
End Sub

und in einem Modul

Option Explicit ' Variablendefinition erforderlich
' damit Makro nicht unter Makro erscheint
Option Private Module
' Projekt weit
Public StOrdner As String ' Suchordner
' von Nepumuk
Private Type InfoT
hwnd As Long
Root As Long
DisplayName As Long
Title As Long
Flags As Long
FName As Long
lParam As Long
Image As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pList As Long, ByVal lpBuffer As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassname As String, ByVal lpWindowName As String) As Long

Function GetAOrdner() As String
Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
With xl
.hwnd = FindWindow("xlmain", vbNullString)
'.hwnd = FindWindow("", "Auswahl") ' Userform Auswahl
.Title = lstrcat("Bitte wählen Sie ein Verzeichnis", "")
.Flags = 1
End With
IDList = SHBrowseForFolder(xl)
If IDList <> 0 Then
FolderName = Space(256)
RVal = SHGetPathFromIDList(IDList, FolderName)
CoTaskMemFree (IDList)
FolderName = Trim(FolderName)
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
GetAOrdner = FolderName
End Function

man könnte den Code noch ausbauen, das in einer Sitzung der Dialog nur einmal erscheint.

Gruß Hajo

Answer 5

Hi
nun ja, viel Aufwand um nur einen Klick zu sparen.
Das mit dem Laufwerksbuchstaben eines USB Sticks läßt sich locker lößen

www.uwe-sieber.de/usbdlm.html

reinhard

Answer 6

hi all :-)

usbstick ist ja meist das letzte laufwerk :-))

wenn dem so sein sollte,ein beispiel

gruss nighty

Option Explicit
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Sub Get_Logical_Drive_String()
Dim DrvString As String
Dim TotDrvs As Long
TotDrvs = GetLogicalDriveStrings(0&, DrvString)
DrvString = String(TotDrvs - 1, " ")
TotDrvs = GetLogicalDriveStrings(TotDrvs, DrvString)
Cells(1, 4) = Mid$(DrvString, Len(DrvString) - 3, 3)
End Sub