Kan bestand niet vinden

[Hightree]

Hallo,

Normaal gesproken kan ik vrij goed met vba overweg, maar nu staik toch voor een raadsel.

In heb werkblad ik de kolommen A en B deels gevuld met gegevens, in kolom A staat staat het huidige volledige pad naar een bestand en in kolom B staat de gewenste nieuwe bestandnaam ( ook het volledige pad ) met de onderstaande code probeer ik dus de bestanden in een map te hernoemen.

Sub cop()
Dim Source As Range
Dim OldFile As String
Dim NewFile As String
Set Source = Cells(1, 1).CurrentRegion
Row = 1
For Row = 1 To Source.Rows.Count
    OldFile = Cells(Row, 1).Value
    NewFile = Cells(Row, 2).Value
    MsgBox OldFile & " -- " & NewFile
' rename files
Name OldFile As NewFile
Next
End Sub

Wanneer ik met de MsgBox de pad namen uitlees, dan kloppen ze, evenals ik in het controle venster OldFile en NewFile controleer, en toch krijg ik de melding dat het bestand niet gevonden kan worden, vreemd toch. Weet iemand hier een oplossing voor?

[jolivanes]

Kan het zijn dat je "Row" niet mag gebruiken?
Als je in plaats van "Row" gewoon "r" gebruikt, werkt het dan?
Anyway, I still have this old code hanging around. Maybe change it to suit your needs.

Sub ChangeInFolder()
Dim OldName As String
Dim NewName As String
Dim LastRow As Long
Dim i As Long


LastRow = Range("A65536").End(xlUp).Row
If Range("C11").Value = "" Then MsgBox "No data in Column C!": Exit Sub
For i = 11 To LastRow
    OldName = Range("A" & i).Value
        NewName = Range("C" & i).Value
        On Error Resume Next
    Name OldName As NewName
Next i




On Error GoTo 0


End Sub

[jolivanes]

Ik heb de code van U veranderd naar

Sub cop()
Dim Source As Range
Dim OldFile As String
Dim NewFile As String
Dim r As Long
Set Source = Cells(1, 3).CurrentRegion
For r = 1 To Source.Rows.Count
    OldFile = Cells(r, 3).Value
    NewFile = Cells(r, 4).Value
Name OldFile As NewFile
Next
End Sub

en dat werkt als een trein.
Om te proberen heb ik wel andere kolommen gebruikt maar dat maakt niets uit.

[Hightree]

Ik heb de code van U veranderd naar

Sub cop()
Dim Source As Range
Dim OldFile As String
Dim NewFile As String
Dim r As Long
Set Source = Cells(1, 3).CurrentRegion
For r = 1 To Source.Rows.Count
    OldFile = Cells(r, 3).Value
    NewFile = Cells(r, 4).Value
Name OldFile As NewFile
Next
End Sub

en dat werkt als een trein.
Om te proberen heb ik wel andere kolommen gebruikt maar dat maakt niets uit.

Hallo,

Had even de hoop dat het zou werken, jammer genoeg krijg ik nog steeds dezelfde melding. Fout 53

Sub cop()
    Dim Source As Range
    Dim OldFile As String
    Dim NewFile As String
    Dim r As Long
    Set Source = Cells(26, 1).CurrentRegion
    For r = 1 To Source.Rows.Count
        OldFile = Cells(r, 1).Value
        NewFile = Cells(r, 2).Value
    Name OldFile As NewFile
    Next
    
End Sub

[Hightree]

Hallo,

Ik moet het nog even testen, maar denk de fout gevonden te hebben, op sommige plaatsen staat na de laatste \ een spatie, zoek nu een werkblad formule om die spatie te verwijderen

[jolivanes]

Zoiets doet je elke keer de das om, is het niet.
Om dat te voorkomen met de "OldFile" namen zou je zoiets kunnen gebruiken (Multiple selections)

Sub FindTheFiles()
Dim arrFiles
Dim i As Integer
arrFiles = Application.GetOpenFilename("All Files (*.*), *.*", , , , True)


For i = LBound(arrFiles) To UBound(arrFiles)
    ActiveSheet.Cells(i, 1).Value = arrFiles(i)
Next i


End Sub

[jolivanes]

Dit is nog een file die ik regelmatig gebruik. Misschien heb je er wat aan.

[Hightree]

Hallo jolivanes,

Gelijk heb je, je vergeet wel eens wat ( mag ook als je 68 bent ) je kent dan alle gereserveerde woorden niet meer uit jehoofd Maar goed, in elk geval hartelijk dank voor je hulp, het enige probleem waar ik nog tegenaan loop is dat er in sommige bestandsnamen zich een ‘ bevindt waardoor de code weer vast loopt, bij zo’n 9000 titels kan dat nog een hele klus worden.
nogmaals bedankt.

[jolivanes]

Re: mag ook als je 68 bent.
Dan ben je nog een jochie! Ik ben een jaar of vier verder.
Misschien werkt dit voor de '

Sub Get_Rid_Of_Character()
    With [A1:A10000]
        .Replace "'", "", xlWhole
    End With
End Sub