Page 1 of 2

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

Posted: Tue Nov 20, 2012 9:42 am
by 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

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

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

Posted: Tue Nov 20, 2012 9:44 am
by 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

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

Posted: Tue Nov 20, 2012 1:15 pm
by bank9597
:D ผมไม่สันทัดเรื่อง VBA เลย ยังไงรออาจารย์หรือท่านอื่นๆ เข้ามาช่วยดูอีกครั้งครับ
หรือลองศึกษาตามกระทู้นี้ดูครับ
http://www.jpsoftwaretech.com/renaming- ... -using-vba

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

Posted: Tue Nov 20, 2012 6:47 pm
by snasui
:D ช่วยโพสต์ Code ให้เป็น Code โดยดูจาก LInk นี้ครับ viewtopic.php?f=3&t=1187

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

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

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

Posted: Tue Nov 20, 2012 8:58 pm
by APY_pooky
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

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

Posted: Tue Nov 20, 2012 9:10 pm
by APY_pooky
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

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

Posted: Tue Nov 20, 2012 9:11 pm
by APY_pooky
ยังคง error Show - > Complies error


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

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

Posted: Tue Nov 20, 2012 9:22 pm
by snasui
:D ช่วยดู Link ที่ผมแนะนำสำหรับการโพสต์ Code ให้เป็น Code อีกสักรอบ เนื่องจากที่โพสต์มานั้นยังไม่ถูกต้องครับ

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

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

Posted: Wed Nov 21, 2012 8:41 am
by 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

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

Posted: Wed Nov 21, 2012 8:43 am
by APY_pooky
cnt = .Cells(.rows.Count, "A:A").End(xlDown).Row

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

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

Posted: Wed Nov 21, 2012 8:44 am
by snasui
:D ลองดูตัวอย่าง 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

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

Posted: Fri Nov 23, 2012 8:21 am
by APY_pooky
ขอบพระคุณอาจารย์ มากครับ

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

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

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

Posted: Fri Feb 07, 2014 9:37 pm
by snasui
:D ลองแนบไฟล์ แนบ Code ที่ใช้ มาดูกันครับ

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

Posted: Wed Jun 11, 2014 12:25 pm
by GTE
snasui wrote::D ลองแนบไฟล์ แนบ Code ที่ใช้ มาดูกันครับ
อาจารย์ครับ ขอสอบถามหน่อยครับว่าพอจะประยุกต์ใช้ Code VBA เพื่อที่ย้าย File ที่เราต้องการย้ายไปยัง Folder ต่างๆ ได้ไหมครับ

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

Posted: Wed Jun 11, 2014 2:31 pm
by logic
Link นี้น่าจะตรงกับที่ต้องการครับ http://www.mrexcel.com/forum/excel-ques ... tions.html

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

Posted: Tue Jan 20, 2015 3:29 pm
by GUSADIID
ขอบคุณครับ :)

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

Posted: Sun Jan 17, 2016 3:08 pm
by 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

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

Posted: Sun Jan 17, 2016 3:50 pm
by snasui
:D ช่วยแนบไฟล์ที่เขียน Code เอาไว้เรียบร้อยแล้วมาด้วยครับ

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

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

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

Posted: Mon Oct 30, 2017 11:14 am
by parakorn
snasui wrote::D ลองดูตัวอย่าง 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
ลองนำไปปรับใช้แล้วไม่ทำงานครับ ผิดพลาดตรงไหนหรือเปล่าครับ
ตามไฟล์แนบครับ :flw: