Daten mittels VBA verschieben

Question

Hallo Exelgemeinde..

Ich habe folgendes Problem. Ich möchte Dateien aus einem Ordner in einen anderen ordner verschieben, wenn ein bestimmtes Ereignis stattgefunden hat.
Bei Eingabe eines Datums in Zelle M8 bis M1000 soll eine Datei (pdf-Datei), die in Zelle B8 bis B1000 spezifiziert ist, verschoben werden.
Die Datei befindet sich auf dem Laufwerk X: im Ordner "aktuell" und soll nach Ordner "zur Zeit in Abrechnung" verschoben werden.
Zum besseren Verständnis habe ich eine Testdatei hochgeladen.
Ich hoffe, mir kann in dieser Frage jemand helfen.
Ich benutze Exel 2003.

M.f.G
Horst

Dateidownload: http://www.file-upload.net/download-8071826/Test.xls.html

Answer 1

hi :-)

ein Beispiel ^^

gruß nighty

einzufuegen
alt+f11/projektexplorer/DeineTabelle

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("M8:M1000")) Is Nothing Then
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("D:\Temp\" & Cells(Target.Row, 2) & ".xls") = True Then
objFSO.MoveFile "D:\Temp\" & Cells(Target.Row, 2) & ".xls", "C:\Temp\"
Else
MsgBox ("Datei nicht vorhanden")
End If
End If
Application.EnableEvents = True
End Sub

Answer 2

hi :-)

mit abfrage auf Datum

gruss nighty

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("M8:M1000")) Is Nothing Then
If IsDate(Target) = True Then
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("D:\Temp\" & Cells(Target.Row, 2) & ".xls") = True Then
objFSO.MoveFile "D:\Temp\" & Cells(Target.Row, 2) & ".xls", "C:\Temp\"
MsgBox ("Datei " & Cells(Target.Row, 2) & ".xls" & " wurde verschoben")
Else
MsgBox ("Datei nicht vorhanden")
End If
End If
End If
Application.EnableEvents = True
End Sub

Answer 3

Hallo @nighty

Vielen Dank für Deine Bemühungen mir zu helfen. Leider funktioniert die hier genannte Lösung nicht. Wie ich bereits zur Eröffnung schilderte, will ich bei einen Datumseintrag in eine der Zellen M8:M1000 eine PDF-Datei, die sich auf den Stick(Laufwerk X:\) im Ordner "aktuell" befindet nach Ordner "zur Zeit in Abrechnung" verschieben lassen.
Die Überprüfung, ob diese Datei vorhanden ist, soll dann als Beispiel auf die Datei 1_NAME, 2_NAME, 3_NAME erfolgen. NAME steht hier als Rechnungsgeber, der Unterstrich ist als Bedingung zwingend notwendig.
Ich habe zum besseren Verständnis nochmals eine Test.EXE hochgelanden, weil dann besser ersichtlich ist, was ich eigentlich damit erreichen will.
Allerdings fangen in der TEST.xml die Zeilen bei 2 statt bei 8 an.

Vielleicht können sich ja noch andere Exel-Experten an einer Lösung beteiligen......


Gruß Horst

Downloadlink:
http://www.file-upload.net/download-8078562/Test.xls.html

Answer 4

Hallo Horst,

Habe ein recherchiertes Konzept getestet, dass von Excel aus nur Dateien von Quellorder zu Zielordner kopieren und einfügen kann.

Bei Änderung des Codes wäre vielleicht auch ein verschieben möglich, gleich nach erfolgter Eingabe des Datums in Spalte M die Datei zu verschieben, kann der Code allerdings nicht.

Leider sind meine VBA Kenntnisse nicht ausreichend um dieses Manko zu beheben.

Vielleicht kann es sich @nigthy oder jemand anders von den VBA-Experten ansehen und die Makros so abzuändern, dass gleich nach erfolgter Eingabe des Datums in Spalte M von Quellordner in den Zielordner verschoben wird.

Um es in Deinem Beispiel wie im Konzept funktionieren zu lassen, könnte ich es mir mit folgender Formel vorstellen und die Makros anzupassen, was bereits geschehen ist.

z. B. in Spalte P:

=HYPERLINK(WENN((B2<>"")*(M2<>"");B2;""))

und runterkopieren bis?

http://www.file-upload.net/download-8079138/Experiment-von-Ordner-nach-Ordner.xls.html

Gruß

Paul1

[sub]Excel > Access > MS-Office 2003
MS Windows XP Professional SP3
MS Windows 7 Professional SP1
ECDL-Syllabus Version 4.0[/sub]

Answer 5

hi :-)

was spricht dagegen pfad und Endung anzupassen ^^

gruss nighty

Answer 6

@nighty

Hallo nighty

Vielen Dank nochmals für die Bemühungen, mir zu helfen. Ich habe jetzt den Code mit der Datumseingabe an meine Tabelle angepaßt. Sieht so aus:


Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("A8:A1000,M8:M1000")) Is Nothing Then
If IsDate(Target) = True Then
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("X:\Programme\Abrechnung\aktuell\" & Cells(Target.Row, 2) & ".pdf") = True Then
objFSO.MoveFile "X:\Programme\Abrechnung\aktuell\" & Cells(Target.Row, 2) & ".pdf", "X:\Programme\Abrechnung\zur Zeit in Abrechnung\"
MsgBox ("Datei " & Cells(Target.Row, 2) & ".pdf" & " wurde verschoben")
Else
MsgBox ("Datei nicht vorhanden")
End If
End If
End If
Application.EnableEvents = True
End Sub

Funktioniert einwandfrei, wenn das Dokument nur einen Namen hat. Das Ganze hat bloß einen Haken. Es könnte z.B. sein, daß es mehrere Rechnungen von einem Arzt gibt, die dann alle gleich heißen würden. Diese Rechnungen erhalten jedoch ein Erstellungdatum, daß in Spalte 1 (A1:A1000) eingetragen wird.
Rechnungen werden von mir dann so abgespeichert: 29.09.2013_Lebender.pdf
Die Abfrage mußte zum Bespiel so aussehen: "29.09.2013_Lebender.pdf"

Wäre es möglich, den Code so zu ändern???

M.f.G.
Horst

PS:
@Pauli1 Vielen Dank, aber das war nicht mein Gedanke. Sollte schon automatisiert sein.
Trotzdem vielen Dank

Answer 7

Hallo nighty,

besten Dank für Deine Nachricht!

An und für sich spricht nichts dagegen, aber mit den vom Fragesteller genannten Pfad hätte der praktische Test nicht funktioniert, deshalb habe ich eigene Pfade verwendet.

Das Konzept ist getestet und funktioniert auf meinem PC.

Jedoch ist es nicht ganz im Sinne des Fragestellers wie in AW4 dargestellt.

Ich hoffe mit meinem Konzept einiges an zeitraubenden Vorarbeiten geleistet zu haben, mehr kann ich als VBA-nobody nicht tun.

Gruß

Paul1

Answer 8

Hallo zusammen,

sorry, hatte Antwort 7 geschrieben ohne Antwort 6 gelesen zu haben.

Kompliment an @ nighty

Gruß

Paul1

Answer 9

hi :-)

probier mal

es werden alle verschoben mit dem Datum aus spalte b
datum wird am anfang des Dateinamens erwartet

leider musst wieder anpassen hihi

pfad wie Endung ^^

gruss nighty

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("M8:M1000")) Is Nothing Then
If IsDate(Target) = True Then
Dim objFSO As Object
Dim DateiNamen() As String
Dim DateiName As String
Dim ArrIndex As Long
ReDim Preserve DateiNamen(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
DateiName = Dir("D:\temp\" & "*.xls")
Do While DateiName <> ""
ArrIndex = ArrIndex + 1
ReDim Preserve DateiNamen(ArrIndex)
DateiNamen(ArrIndex) = DateiName
DateiName = Dir
If Cells(Target.Row, 2) = Mid(DateiNamen(ArrIndex), 1, Len(Cells(Target.Row, 2))) Then
objFSO.MoveFile "D:\Temp\" & DateiNamen(ArrIndex), "C:\Temp\"
End If
Loop
End If
End If
Application.EnableEvents = True
End Sub

Answer 10

hi :-)

sieht ja irgendwie konfus aus,wird noch optimiert falls es passt ^^

gruss nighty