title image


Smiley Bilder verschieben und umbenennen

Hallo zusammen,

ich bin am verzweifeln. Ich versuche gerade ein Script zu entwickeln, was mir ermöglich Bilder auf den Deskop auf einen bestimmten Laufwerk zu verschieben in einen Ordner wenn er existieren sollte, soll er ihn nicht anlegen und wenn Bilder drin sind xxxxxxx_x_01 fortlaufend mit einer höheren Zahl also xxxxxxx_x_02 etc.

Ich habe es auf gesplittet, er soll erst prüfen ob der Ordner exisistiert, das funktioniert.

Dim Ord As StringDim Antwort As Integer

 Ord = "L:\Allgemein\Ident_Blatt\Bilder\" & rs("Sachnummer")

   If Dir(Ord, vbDirectory) <> "" Then       MsgBox "Ordner ist schon vorhanden"   Else   Antwort = MsgBox("Der Ordner " & Ord & " ist nicht vorhanden." _           & vbNewLine _           & "soll der Ordner angelegt werden?!", vbYesNo)       If Antwort = vbYes Then'Falls kein LW angegeben ist, erstellt die MkDir-Anweisung'den neuen Ordner auf dem aktuellen LW.'LW wurde aber durch "L:\Allgemein\Ident_Blatt\Bilder\Sachnummer" festgelegt       MkDir Ord       MsgBox "Ordner " & Ord & " angelegt"       Else       MsgBox "Es wurden keine Änderungen vorgenommen"       Exit Sub       End If   End If

Als zweites, wenn der Ordner existiert, dann ließ mir die Dateien aus um den Größten zu ermitteln.

    Dim AktDatei As String    Dim rs7 As Recordset    Dim fldDATEI As Field    Dim fldSachnummer_Bild As Field    Dim Dateiname As String    Dim SuchVerzeichnis As String   

    Set rs = CurrentDBC.OpenRecordset(strSQL, dbOpenSnapshot)    Dateiname = rs("Sachnummer")    SuchVerzeichnis = "L:\Allgemein\Ident_Blatt\Bilder\" & Dateiname & "\"    Const DatTyp = ""    Const ZielTab = "Bilder_Umbenennung"          'Leeren der Tabelle "aktueller Stand"

DoCmd.RunSQL "DELETE * " & _             "FROM [Bilder_Umbenennung]"            

'Einlesen Bilder und Änderungsdatum    Set rs7 = CurrentDBC.OpenRecordset(ZielTab)    Set fldDATEI = rs7("Bild_Alt")    Set fldSachnummer_Bild = rs7("Sachnummer")    AktDatei = Dir(SuchVerzeichnis & "\" & DatTyp)    While Len(AktDatei) > 0         Debug.Print AktDatei         rs7.AddNew

         fldDATEI.Value = "L:\Allgemein\Ident_Blatt\Bilder\" & Dateiname & "\" & AktDatei         fldSachnummer_Bild = Dateiname

         rs7.Update         AktDatei = Dir                                        ' nächste Datei    Wend    rs7.Close    Set rs7 = Nothing

Als drittes kommt die Umbenennung er soll mir die Bilder auslesen, die umbenannt werden und dann das ganze Plus 01 von den Max wert,

ich bekomme das verschieben nicht hin sowie den Wert +1 ich habe es über Recordset versucht.

Dim AktDatei1 As String    Dim rs8 As Recordset    Dim rs9 As Recordset    Dim fldDATEI1 As Field    Dim fldSachnummer_Bild1 As Field    Dim Dateiname1 As String    Dim SuchVerzeichnis1 As String    Dim Ziel_Pfad As String    Dim Quell_Pfad As String    Dim strSQL9 As String    Dim fldBild_N_Neu As Field

    Dateiname1 = rs("Sachnummer")    SuchVerzeichnis1 = "C:\Users\" & fOSUserName & "\Desktop\Bilder_Identblatt\"    Const DatTyp1 = ""    Const ZielTab1 = "Bilder_Umbenennung_N"              'Leeren der Tabelle "aktueller Stand"

DoCmd.RunSQL "DELETE * " & _             "FROM [Bilder_Umbenennung_N]"             strSQL9 = "SELECT Bilder_Umbenennung.Sachnummer, Max(Bilder_Umbenennung.AI) AS MaxvonAI, Max(Bilder_Umbenennung.Maxwert) AS MaxvonMaxwert, Max([Bilder_Umbenennung].[Sachnummer]+'_'+[Bilder_Umbenennung].[AI]+'_'+[Bilder_Umbenennung].[Max_Endung]) AS Zusammenfassung " & _          "FROM Bilder_Umbenennung " & _          "GROUP BY Bilder_Umbenennung.Sachnummer"

'Einlesen Bilder und Änderungsdatum    Set rs8 = CurrentDBC.OpenRecordset(ZielTab1)    Set rs9 = CurrentDBC.OpenRecordset(strSQL9, dbOpenDynaset)    Set fldDATEI1 = rs8("Bild_Neu")    Set fldBild_N_Neu = rs9("Zusammenfassung")'    Set fldSachnummer_Bild = rs7("Sachnummer")    AktDatei1 = Dir(SuchVerzeichnis1 & "\" & DatTyp1)    While Len(AktDatei1) > 0         Debug.Print AktDatei1         rs8.AddNew

         fldDATEI1.Value = "C:\Users\" & fOSUserName & "\Desktop\Bilder_Identblatt\" & AktDatei1

         Quell_Pfad = fldDATEI1         Ziel_Pfad = "L:\Allgemein\Ident_Blatt\Bilder\" & Dateiname & "\" & fldBild_N_Neu

         My.Computer.FileSystem.MoveFile Quell_Pfad, Ziel_Pfad

         rs8.Update         AktDatei1 = Dir                                        ' nächste Datei    Wend    rs8.Close    Set rs8 = Nothing

 

Ich hoffe ihr könnt mir helfen :()

 

lg

Rene

 

 

 



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: