Thema Datum  Von Nutzer Rating
Antwort
03.01.2013 12:03:19 Benjamin
NotSolved
Blau Dateinen Anhand Excel-Tabelle umbenennen - in kompliziert
03.01.2013 17:43:55 Trägheit
NotSolved
04.01.2013 10:51:53 Benjamin
NotSolved
04.01.2013 13:14:35 schokobons
NotSolved
04.01.2013 13:34:04 Benjaminnein das ist
NotSolved
04.01.2013 13:28:59 Trägheit
NotSolved
04.01.2013 13:37:55 Benjamin
NotSolved
04.01.2013 13:54:50 Trägheit
NotSolved
04.01.2013 14:03:43 Trägheit
NotSolved
06.01.2013 10:17:34 Benjamin
NotSolved
07.01.2013 18:49:11 Trägheit
NotSolved
08.01.2013 09:06:31 Benjamin
Solved
08.01.2013 15:33:09 Trägheit
NotSolved
04.01.2013 11:20:00 Gast77253
NotSolved
15.01.2013 23:11:23 Stefan
NotSolved

Ansicht des Beitrags:
Von:
Trägheit
Datum:
03.01.2013 17:43:55
Views:
1286
Rating: Antwort:
  Ja
Thema:
Dateinen Anhand Excel-Tabelle umbenennen - in kompliziert

Datensicherung vorher nicht vergessen.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
Option Explicit
 
Private Declare Function PathAddBackslash Lib "shlwapi.dll" _
  Alias "PathAddBackslashA" ( _
  ByVal pszPath As String) As Long
 
Sub Ausprobieren()
   
  Dim wks         As Excel.Worksheet
  Dim rngResult   As Excel.Range
  Dim f()         As String
  Dim strPath     As String
  Dim strFileN    As String
  Dim strFileID   As String
  Dim n           As Long
  Dim i           As Long
   
  Set wks = ThisWorkbook.Worksheets(1)
   
  strPath = AddBackslash(ThisWorkbook.Path)
   
  n = GetJPGs(strPath, f)
   
  Debug.Print vbNewLine & Now & " >>>"
  For i = 1 To n
     
    strFileID = GetID(f(i))
     
    Set rngResult = wks.Columns("A").Find(strFileID)
    If Not rngResult Is Nothing Then
       
      strFileN = Trim$(wks.Columns("B").Rows(rngResult.Row).Text)
       
      'neuer Dateiname darf noch nicht existieren
      If Not Dir(strPath & strFileN) <> "" Then
         
        On Error Resume Next
          'datei umbenennen
          Name strPath & f(i) As strPath & strFileN
          If Err.Number = 0 Then
          'OK
            Debug.Print " # " & f(i) & " >> " & strFileN
          Else
          'Fehler
            Debug.Print " ! " & f(i) & " | ID " & strFileID & " konnte NICHT umbenannt werden (Fehler " & Err.Number & "; " & Err.Description & ")"
          End If
        On Error GoTo 0
         
      Else
        'Problembehandlung
        Debug.Print " ? " & f(i) & " >> " & strFileN & " | wurde nicht ausgeführt (Zieldatei existiert bereits)"
      End If
       
    Else
      'Problembehandlung
      Debug.Print " ? " & f(i) & " | ID " & strFileID & " konnte NICHT in Liste gefunden werden"
    End If
     
  Next
  Debug.Print "<<<"
   
End Sub
 
Private Function GetID(File As String) As String
  Dim i As Long
  For i = 1 To Len(File)
    If IsNumeric(Mid$(File, i, 1)) Then
      GetID = GetID & Mid$(File, i, 1)
    Else
      Exit For
    End If
  Next
End Function
 
Private Function GetJPGs(Path As String, File() As String) As Long
   
  Dim f() As String
  Dim strFile$
  Dim n&
   
  strFile = Dir(Path & "*.jpg")
  While strFile <> ""
    n = n + 1
    ReDim Preserve f(1 To n)
    f(n) = strFile
    strFile = Dir()
  Wend
   
  File = f
  GetJPGs = n
   
  Erase f
   
End Function
 
Private Function AddBackslash(ByVal Path As String) As String
  ' Sicherstellen, dass sich am Ende des Pfades ein \
  ' befindet, also nicht "C:\windows", sondern "C:\windows\"
  Dim sBuf As String
  sBuf = Path + String(100, 0)
  Call PathAddBackslash(sBuf)
  AddBackslash = RemNulls(sBuf)
End Function
 
Private Function RemNulls(ByVal sStr As String) As String
  ' Entfernt die Nullzeichen am Ende eines Strings
  Dim lPos As Long
  lPos = InStr(1, sStr, vbNullChar)
  If lPos > 0 Then
      RemNulls = Left(sStr, lPos - 1)
  Else
      RemNulls = sStr
  End If
End Function

Trifft das die Problematik?


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
03.01.2013 12:03:19 Benjamin
NotSolved
Blau Dateinen Anhand Excel-Tabelle umbenennen - in kompliziert
03.01.2013 17:43:55 Trägheit
NotSolved
04.01.2013 10:51:53 Benjamin
NotSolved
04.01.2013 13:14:35 schokobons
NotSolved
04.01.2013 13:34:04 Benjaminnein das ist
NotSolved
04.01.2013 13:28:59 Trägheit
NotSolved
04.01.2013 13:37:55 Benjamin
NotSolved
04.01.2013 13:54:50 Trägheit
NotSolved
04.01.2013 14:03:43 Trägheit
NotSolved
06.01.2013 10:17:34 Benjamin
NotSolved
07.01.2013 18:49:11 Trägheit
NotSolved
08.01.2013 09:06:31 Benjamin
Solved
08.01.2013 15:33:09 Trägheit
NotSolved
04.01.2013 11:20:00 Gast77253
NotSolved
15.01.2013 23:11:23 Stefan
NotSolved