:ต้องการ rename file in folder:

[APY_pooky]

:ต้องการ rename file in folder:
1.Column A = now paht file in folder
2.Column B = old name
3.Column C = new name
4.ต้องการ rename file จาก old name เป็น new name โดยยังคง property เดิม, เช่น .pdf, .xlxs, .pptx

As script Code

Sub RenameFile()


Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(“List”)
Dim NowPath As String, OldName As String, NewName As String
Dim Row As Long

NowPath = wb.Path
ws.Select

For Row = 2 To cnt + 1
OldName = NowPath & “ \ ” & Cells(Row, 2)
If Cells(Row, 2) <> “” Then
If Cells(Row, 2) <> wb.Name Then
NewName = NowPath & “ \ ” & Cells(Row, 3)
Name OldName As NewName
End If
End If
Next

End Sub


ขึ้น error Subscript out of range

รบกวนผู้รู้แนะนำหน่อยครับ

[APY_pooky]

โพสต์แล้ว: 20 พ.ย. 2012 09:42








:ต้องการ rename file in folder:
1.Column A = now paht file in folder
2.Column B = old name
3.Column C = new name
4.ต้องการ rename file จาก old name เป็น new name โดยยังคง property เดิม, เช่น .pdf, .xlxs, .pptx

[bank9597]

ผมไม่สันทัดเรื่อง VBA เลย ยังไงรออาจารย์หรือท่านอื่นๆ เข้ามาช่วยดูอีกครั้งครับ
หรือลองศึกษาตามกระทู้นี้ดูครับ
http://www.jpsoftwaretech.com/renaming- ... -using-vba

[snasui]

ช่วยโพสต์ Code ให้เป็น Code โดยดูจาก LInk นี้ครับ viewtopic.php?f=3&t=1187

สำหรับ Code ที่เขี่ยนมาต้องคีย์เปลี่ยนเครื่องหมาย "" ที่ครอบอักขระอยู่ในหลาย ๆ ส่วนเสียใหม่ เนื่อกจากโปรแกรมไมได้มองว่าเป็นฟันหนู และอีกประการ จาก Code

For Row = 2 To cnt + 1 ผมพบว่ายังไม่ได้กำหนดค่าให้กับตัวแปร cnt ว่ามีค่าเท่าใด ลองปรับแก้ตามที่ผมบอกแล้วช่วยแจ้งมาใหม่หากพบว่ามี Error หรือหากยังไม่ได้ตามเป้าหมายที่ต้องการ

[APY_pooky]

Code: Select all

Sub RenameFile()


Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(“List”)
Dim NowPath As String, OldName As String, NewName As String
Dim Row As Long

NowPath = wb.Path
ws.Select

For Row = 2 To cnt + 1
OldName = NowPath & “ \ ” & Cells(Row, 2)
If Cells(Row, 2) <> “” Then
If Cells(Row, 2) <> wb.Name Then
NewName = NowPath & “ \ ” & Cells(Row, 3)
Name OldName As NewName
End If
End If
Next

End Sub

Code: Select all

[APY_pooky]

Code: Select all

Sub RenameFile()


Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(“List”)
Dim NowPath As String, OldName As String, NewName As String
Dim Row As Long

NowPath = wb.Path
ws.Select
cnt = .Cells(.Rows.Count, "A:A").End(xlDown).Row
For Row = 2 To cnt + 1
OldName = NowPath & “ \ ” & Cells(Row, 2)
If Cells(Row, 2) <> “” Then
If Cells(Row, 2) <> wb.Name Then
NewName = NowPath & “ \ ” & Cells(Row, 3)
Name OldName As NewName
End If
End If
Next

End Sub

Code: Select all

[APY_pooky]

ยังคง error Show - > Complies error


รบกวนแนะนำด้วยครับ
ขอบคุณครับ

[snasui]

ช่วยดู Link ที่ผมแนะนำสำหรับการโพสต์ Code ให้เป็น Code อีกสักรอบ เนื่องจากที่โพสต์มานั้นยังไม่ถูกต้องครับ

ช่วยดูมาให้ด้วยว่า Error ที่บรรทัดใดของ Code ที่เขียนมาครับ

[APY_pooky]

Code: Select all

Sub RenameFile()


Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(“List”)
Dim NowPath As String, OldName As String, NewName As String
Dim Row As Long, cnt As String

NowPath = wb.Path
ws.Select
cnt = .Cells(.rows.Count, "A:A").End(xlDown).Row
For Row = 2 To cnt + 1
OldName = NowPath & “ \ ” & Cells(Row, 2)
If Cells(Row, 2) <> “” Then
If Cells(Row, 2) <> wb.Name Then
NewName = NowPath & “ \ ” & Cells(Row, 3)
Name OldName As NewName
End If
End If
Next

End Sub

[APY_pooky]

cnt = .Cells(.rows.Count, "A:A").End(xlDown).Row

ติด Complies Error ที่บรรรทัดนี้ครับ
รบกวนผู้รู้แนะนำหน่อยครับ

[snasui]

ลองดูตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub DoSomething()
    Dim rAll As Range
    Dim r As Range
    With Sheets("List")
        Set rAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    For Each r In rAll
         MyPath = r.Value
         MyFile = r.Offset(0, 1).Value
         NewName = r.Offset(0, 2).Value
         If Dir(MyPath & MyFile) <> "" Then
             Name MyPath & MyFile As MyPath & NewName
         End If
     Next r
End Sub

[APY_pooky]

ขอบพระคุณอาจารย์ มากครับ

[GTE]

สามารถใช้เปลี่ยนกับ File pdf ได้หรือไม่ครับ (ทดลองแล้วมันไม่ Rename ให้ครับ) หรือว่าผมใส่ชื่อในส่วนของ Now Paht ผิดครับ ผมใส่เป็น D:/Scan ชื่อไดร์ D ของผมเป็น Local Disk (D:) ไม่แน่ใจว่าเกี่ยวหรือไม่ครับ ขอความรู้ด้วยครับ

[snasui]

ลองแนบไฟล์ แนบ Code ที่ใช้ มาดูกันครับ

[GTE]

ลองแนบไฟล์ แนบ Code ที่ใช้ มาดูกันครับ

อาจารย์ครับ ขอสอบถามหน่อยครับว่าพอจะประยุกต์ใช้ Code VBA เพื่อที่ย้าย File ที่เราต้องการย้ายไปยัง Folder ต่างๆ ได้ไหมครับ

[logic]

Link นี้น่าจะตรงกับที่ต้องการครับ http://www.mrexcel.com/forum/excel-ques ... tions.html

[GUSADIID]

ขอบคุณครับ

[beam907]

สวัสดีครับ อาจารย์ ผมต้องการ rename file in folder ตามที่แนบตราง book1.xlsx มาครับ



NowPath OldName NewName
D:\test U6201025_P_SMALL.JPG 100.JPG
D:\test U6201026_P_SMALL.JPG 101.JPG
D:\test U6201027_P_SMALL.JPG 102.JPG
D:\test U6201028_P_SMALL.JPG 103.JPG
D:\test U6201029_P_SMALL.JPG 104.JPG
D:\test U6201030_P_SMALL.JPG 105.JPG
D:\test U6201031_P_SMALL.JPG 106.JPG
D:\test U6201032_P_SMALL.JPG 107.JPG
D:\test U6201033_P_SMALL.JPG 108.JPG
D:\test U6201034_P_SMALL.JPG 109.JPG
D:\test U6201035_P_SMALL.JPG 110.JPG
D:\test U6201036_P_SMALL.JPG 111.JPG
D:\test U6201037_P_SMALL.JPG 112.JPG
D:\test U6201038_P_SMALL.JPG 113.JPG
D:\test U6201039_P_SMALL.JPG 114.JPG
D:\test U6201040_P_SMALL.JPG 115.JPG
D:\test U6201041_P_SMALL.JPG 116.JPG
D:\test U6201042_P_SMALL.JPG 117.JPG
D:\test U6201043_P_SMALL.JPG 118.JPG
D:\test U6201044_P_SMALL.JPG 119.JPG
D:\test U6201045_P_SMALL.JPG 120.JPG
D:\test U6201046_P_SMALL.JPG 121.JPG
D:\test U6201047_P_SMALL.JPG 122.JPG
D:\test U6201048_P_SMALL.JPG 123.JPG
D:\test U6201049_P_SMALL.JPG 124.JPG
D:\test U6201050_P_SMALL.JPG 125.JPG
D:\test U6201051_P_SMALL.JPG 126.JPG
D:\test U6201052_P_SMALL.JPG 127.JPG
D:\test U6201053_P_SMALL.JPG 128.JPG
D:\test U6201054_P_SMALL.JPG 129.JPG
D:\test U6201055_P_SMALL.JPG 130.JPG
D:\test U6201056_P_SMALL.JPG 131.JPG
D:\test U6201057_P_SMALL.JPG 132.JPG
D:\test U6201058_P_SMALL.JPG 133.JPG
D:\test U6201059_P_SMALL.JPG 134.JPG
D:\test U6201060_P_SMALL.JPG 135.JPG
D:\test U6201061_P_SMALL.JPG 136.JPG
D:\test U6201062_P_SMALL.JPG 137.JPG
D:\test U6201063_P_SMALL.JPG 138.JPG
D:\test U6201064_P_SMALL.JPG 139.JPG
D:\test U6201065_P_SMALL.JPG 140.JPG
D:\test U6201066_P_SMALL.JPG 141.JPG
D:\test U6201025_T_SMALL.JPG 142.JPG
D:\test U6201026_T_SMALL.JPG 143.JPG
D:\test U6201027_T_SMALL.JPG 144.JPG
D:\test U6201028_T_SMALL.JPG 145.JPG
D:\test U6201029_T_SMALL.JPG 146.JPG
D:\test U6201030_T_SMALL.JPG 147.JPG
D:\test U6201031_T_SMALL.JPG 148.JPG
D:\test U6201032_T_SMALL.JPG 149.JPG
D:\test U6201033_T_SMALL.JPG 150.JPG
D:\test U6201034_T_SMALL.JPG 151.JPG
D:\test U6201035_T_SMALL.JPG 152.JPG
D:\test U6201036_T_SMALL.JPG 153.JPG
D:\test U6201037_T_SMALL.JPG 154.JPG
D:\test U6201038_T_SMALL.JPG 155.JPG
D:\test U6201039_T_SMALL.JPG 156.JPG
D:\test U6201040_T_SMALL.JPG 157.JPG
D:\test U6201041_T_SMALL.JPG 158.JPG
D:\test U6201042_T_SMALL.JPG 159.JPG
D:\test U6201043_T_SMALL.JPG 160.JPG
D:\test U6201044_T_SMALL.JPG 161.JPG
D:\test U6201045_T_SMALL.JPG 162.JPG
D:\test U6201046_T_SMALL.JPG 163.JPG
D:\test U6201047_T_SMALL.JPG 164.JPG
D:\test U6201048_T_SMALL.JPG 165.JPG
D:\test U6201049_T_SMALL.JPG 166.JPG
D:\test U6201050_T_SMALL.JPG 167.JPG
D:\test U6201051_T_SMALL.JPG 168.JPG
D:\test U6201052_T_SMALL.JPG 169.JPG
D:\test U6201053_T_SMALL.JPG 170.JPG
D:\test U6201054_T_SMALL.JPG 171.JPG
D:\test U6201055_T_SMALL.JPG 172.JPG
D:\test U6201056_T_SMALL.JPG 173.JPG
D:\test U6201057_T_SMALL.JPG 174.JPG
D:\test U6201058_T_SMALL.JPG 175.JPG
D:\test U6201059_T_SMALL.JPG 176.JPG
D:\test U6201060_T_SMALL.JPG 177.JPG
D:\test U6201061_T_SMALL.JPG 178.JPG
D:\test U6201062_T_SMALL.JPG 179.JPG
D:\test U6201063_T_SMALL.JPG 180.JPG
D:\test U6201064_T_SMALL.JPG 181.JPG
D:\test U6201065_T_SMALL.JPG 182.JPG
D:\test U6201066_T_SMALL.JPG 183.JPG

ผมใช้ vba ของอาจารย์ตามข้างล่างนี้ครับ

Sub DoSomething()
Dim rAll As Range
Dim r As Range
With Sheets("List")
Set rAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
For Each r In rAll
MyPath = r.Value
MyFile = r.Offset(0, 1).Value
NewName = r.Offset(0, 2).Value
If Dir(MyPath & MyFile) <> "" Then
Name MyPath & MyFile As MyPath & NewName
End If
Next r
End Sub


ทำไมชื่อไฟล์ใน Folder D:test ถึงยังไม่เปลี่ยนชื่อครับ?

ขอขอบคุณครับ USER beam907 Email:beam907@yahoo.com

[snasui]

ช่วยแนบไฟล์ที่เขียน Code เอาไว้เรียบร้อยแล้วมาด้วยครับ

สำหรับการโพสต์ Code ควร โพสต์ให้แสดงเป็น Code ดูตัวอย่างที่นี่ครับ viewtopic.php?f=6&t=1187

วิธีการแนบไฟล์ดูที่นี่ครับ viewtopic.php?f=2&t=1132#p45444

[parakorn]

ลองดูตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub DoSomething()
    Dim rAll As Range
    Dim r As Range
    With Sheets("List")
        Set rAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    For Each r In rAll
         MyPath = r.Value
         MyFile = r.Offset(0, 1).Value
         NewName = r.Offset(0, 2).Value
         If Dir(MyPath & MyFile) <> "" Then
             Name MyPath & MyFile As MyPath & NewName
         End If
     Next r
End Sub

ลองนำไปปรับใช้แล้วไม่ทำงานครับ ผิดพลาดตรงไหนหรือเปล่าครับ
ตามไฟล์แนบครับ