Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1284to1288
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Problem Dateien verschieben

Problem Dateien verschieben
13.11.2012 23:14:26
Christian
Hey Leute,
ich habe ein vba makro um Dateinamen und Ordnernamen auszulesen, welches funktioniert wenn ich Dateien/Ordner einfuege bzw loesche ( Dank euch Office Forum ), jedoch ist mir heute ein kleiner Fehler aufgefallen.
Wenn ich eine Datei von Ordner A in B verschiebe spinnt das programm und zeigt die ordner dann nicht mehr richtig an.
Ausgangszustand
1.doc in ordner test1
2.doc in ordner test2
3.doc in ordner test3
Wird auch so in meiner excel tabelle angezeigt.
Nun verschiebe ich 3.doc in ordner test1 und fuehre das makro erneut aus.
Folgendes resultat
1.doc in ordner test 1
3.doc in ordner test 1
2.doc in ordner test 2
3.doc in ordner test 3
Dieser Problem tritt nur auf wenn ich ordner verschiebe.
Hier mein Code
Code:
Option Explicit
Private Declare Function SearchTreeForFile Lib "imagehlp.dll" ( _
ByVal RootPath As String, _
ByVal InputPathName As String, _
ByVal InputPathBuffer As String) As Long
Private Const MAX_PATH = 260
Public Sub Incoming_Correspondence()
Dim objFSO As Object, objFolder As Object
Dim objSubfolder As Object, colSubfolders As Object
Dim strPfad As String, strDatei As String
Dim strTemp As String * MAX_PATH
Dim lngRow As Long, lngReturn As Long, ialngIndex As Long
Dim avntFiles As Variant
strPfad = "L:\AL_Sales\MELsales\2011 SALES\2011 Current Projects\" & [E3] & "\02-Incomming   _
_
Correspondence\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPfad)
Set colSubfolders = objFolder.Subfolders
Application.ScreenUpdating = False
With Worksheets("02-Incoming Correspondence")
avntFiles = .Range(.Cells(1, 5), .Cells( _
.Rows.Count, 5).End(xlUp)).Value2
If IsArray(avntFiles) Then
For ialngIndex = UBound(avntFiles) To 10 Step -1
lngReturn = SearchTreeForFile(strPfad, _
avntFiles(ialngIndex, 1), strTemp)
If lngReturn = 0 Then .Rows(ialngIndex).delete
Next
End If
lngRow = 9
strDatei = Dir$("L:\AL_Sales\MELsales\2011 SALES\2011 Current Projects\" & [E3] & "\02- _
Incomming Correspondence\*.*")
Do Until strDatei = ""
lngRow = lngRow + 1
If .Cells(lngRow, 5).Value  strDatei Then
.Rows(lngRow).Insert
.Cells(lngRow, 5).Value = strDatei
.Cells(lngRow, 7).Value = objFolder.Name
.Cells(lngRow, 5).Hyperlinks.Add Worksheets("02-Incoming Correspondence").Cells( _
lngRow, 5), strPfad + strDatei, "Klicken, um zu öffnen."
.Cells(lngRow, 7).Hyperlinks.Add Worksheets("02-Incoming Correspondence").Cells( _
lngRow, 7), strPfad, "Klicken, um zu öffnen."
End If
strDatei = Dir$
Loop
For Each objSubfolder In colSubfolders
strDatei = Dir$("L:\AL_Sales\MELsales\2011 SALES\2011 Current Projects\" & [E3] & "\ _
_
02-Incomming Correspondence\" & objSubfolder.Name & "\*.*")
Do Until strDatei = ""
lngRow = lngRow + 1
If .Cells(lngRow, 5).Value  strDatei Then
.Rows(lngRow).Insert
.Cells(lngRow, 5).Value = strDatei
.Cells(lngRow, 7).Value = objSubfolder.Name
.Cells(lngRow, 5).Hyperlinks.Add Worksheets("02-Incoming Correspondence"). _
_
Cells(lngRow, 5), objSubfolder.Path + "\" + strDatei, "Klicken, um zu öffnen."
.Cells(lngRow, 7).Hyperlinks.Add Worksheets("02-Incoming Correspondence").Cells( _
lngRow, 7), objSubfolder.Path, "Klicken, um zu öffnen."
End If
strDatei = Dir$
Loop
Next
End With
Dim n As Integer
For n = 1 To lngRow
If Worksheets("02-Incoming Correspondence").Range("E" & n + 9)  "" Then
Worksheets("02-Incoming Correspondence").Range("A" & n + 9) = n
End If
Next n
Range("A" & n + 9) = ""
Set objFolder = Nothing
Set colSubfolders = Nothing
Set objFSO = Nothing
Application.ScreenUpdating = True
End Sub

Ueber jegliche hilfe und tipps waere ich ueberaus dankbar.
grus

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem Dateien verschieben
16.11.2012 07:33:56
fcs
Hallo Christian,
ich verstehe nicht, warum du erst per "SearchTreeForFile" prüfst, ob die aktuell in der Tabelle eingetragenen Dateien noch existieren und dann bestimmte Zeilen löscht.
Sind das die Zeilen mit nicht mehr existierenden Dateien?
Wenn ja, dann wird die Zeile mit einer verschobenen Datei nicht gelöscht, da sie ja jetzt in einem anderen Unterordner vorhanden ist.
Warum löscht du im Makro nicht alle vorhandenen Datei-Einträge und generierst die Liste mit den in den Ordnern vorhanden Dateien komplett neu?
Gruß
Franz

AW: Problem Dateien verschieben
18.11.2012 22:30:11
Christian
Hey Franz,
danke erstmal fuer das interesse an meinem problem, ich verschiebe die zeilen und fuege neue ein, weil nicht nur die generierten werte in der zeile vorhanden sind.
z.b wenn ich eine neue datei erhalte test.doc, dann schreibe ich in die zeile erhalten von: Max Musterman. Daher kann ich leider nicht alles loeschen und neu generieren da diese information dann nicht mehr in der richtigen zeile stehen wuerde.
Daher wuerde es mir auch nicht helfen wenn er die verschobene datei loescht und dann einfach wieder neu eintraegt, da die informationen damit auch verschwinden. Wenn eine datei verschoben wird, sollte das program eigentlich nur den Hyperlink aendern, das waere eigentlich perfekt, ob die dateien dann alphabetisch sind oder nicht ist mir egal.
ich hoffe ich konnte erklaeren was ich meine, ansonsten kann ich auch ein paar screenshots der tabelle hochladen falls das dir hilft.
grus chris
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige