Hallo Mirko,
Diese Frage hättest Du besser ins VB Classic Einsteiger Forum geschieben.
Es geht so:
Öffne das VBA Fenster [Alt]+[F11]. Blende den Project Exploere ein [Strg]+[R] (oder übers Menü).
Öffne (Doppelklick) im Ordner Excel Objects das Tabellenblatt, das Deine Daten enthält.
Jetzt müsste ein leeres Fenster erscheien, in dem nur "Option Explicit" steht und über dem zwei Dropdown Felder sind, in denen "General" und "(Deklarations)" steht.
TIPP: Wenn "option Explicit" nicht drin steht, schreibe es rein und gehe im Menü (Extras - Optionen) in den Dialog und aktiviere die Option "Variablen Deklaration" erzwingen. Dann fallen Tippfehler bei Variablen bereits beid er Eingabe auf.
Jetzt wähle aus dem linken Dropdown das "Worksheet" und aus dem Rechten "BeforeDoubleClick".
Die Private Sub Worksheet_SelectionChange(ByVal Target As Range) ... End Sub kannste wiederlöschen. Wir arbeiten jetzt nur mit der
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As _
Boolean)
End Sub Die füllen wir jetzt mit leben. Zuerst Laden wir die Daten aus dem Arbeitsbaltt in Variablen:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As _
Boolean)
Dim queS As String ' Quell Pfad
Dim zilS As String ' Ziel Pfad
Dim filS As String ' Datei Name
Dim WS as Excel.Worksheet ' Das Arbeitsbaltt
Dim rwL As Long ' Excel Zeile
set WS = Target.Tarent
rwL = Target.Tow
filS=WS.Cells(rwL,1).Text
queS=WS.Cells(rwL,2).Text
zilS=WS.Cells(rwL,3).Text
Msgbox "Kopiere:" & filS & vbcrlf & "aus: " & queS & vbcrlf & "nach:" & zilS
Cancel=true
End Sub Wenn Du jetzt eine Zelle in der Zeile mit Deinen Daten doppelt anklickst, erscheient eine Message Box, die Dir Deinen "Auftrag" annzeigt.
Jetzt müssen wir das auf die Files anwenden. Dazu greife ich auf das Scripting FileSystemObject zu, das hoffentlich auf Deinem Rechner mit drauf ist.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As _
Boolean)
Dim queS As String ' Quell Pfad
Dim zilS As String ' Ziel Pfad
Dim filS As String ' Datei Name
Dim WS as Excel.Worksheet ' Das Arbeitsbaltt
Dim rwL As Long ' Excel Zeile
' Library Scripting C:\WINDOWS\system32\scrrun.dll Microsoft Scripting Runtime
Dim FSO As Object ' As Scripting.FileSystemObject
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set FSO = CreateObject("Scripting.FileSystemObject")
set WS = Target.Tarent
rwL = Target.Tow
filS=trim(WS.Cells(rwL,1).Text)
queS=trim(WS.Cells(rwL,2).Text)
zilS=trim(WS.Cells(rwL,3).Text)
' Msgbox "Kopiere:" & filS & vbcrlf & "aus: " & queS & vbcrlf & "nach:" & zilS
If Not FSO.FolderExists(queS) Then
MsgBox "Quellverzeichnis " & vbcrlf & queS & vbcrlf & "nicht gefunden", _
vbCritical+vbOKOnly, "ABBRUCH"
WS.Cells(rwL,4)="ABBRUCH Quellverzeichnis nicht gefunden"
Exit Sub
END IF
If Not FSO.FolderExists(zilS) Then
MsgBox "Zielverzeichnis " & vbcrlf & zilS & vbcrlf & "nicht gefunden", _
vbCritical+vbOKOnly, "ABBRUCH"
WS.Cells(rwL,4)="ABBRUCH Zielverzeichnis nicht gefunden"
Exit Sub
END IF
If right(queS,1) <> "\" Then ques=ques & "\"
If right(zilS,1) <> "\" Then zilS=zilS & "\"
ques=ques & fils
zilS=zilS & filS
If Not FSO.FileExists(queS) Then
MsgBox "Quelldatei " & vbcrlf & queS & filS & vbcrlf & "nicht gefunden", _
vbCritical+vbOKOnly, "ABBRUCH"
WS.Cells(rwL,4)="ABBRUCH Quelldatei nicht gefunden"
Exit Sub
END IF
If FSO.FileExists(zilS) Then
WS.Cells(rwL,4)="Zieldatei wird überschrieben"
END IF
FSO.CopyFile ques, zils, true
IF WS.Cells(rwL,4).text="Zieldatei wird überschrieben" Then
WS.Cells(rwL,4)="Zieldatei überschrieben"
ELSE
WS.Cells(rwL,4)="Datei kopiert"
End if
Cancel=true
End Sub |
Forenübersicht Suchen Forumsregeln
Juni 2024
Sie sind aktuell nicht angemeldet.
