Page 1 of 1
Macro | สร้าง Folder ใหม่ โดยใช้ Script
Posted: Sun Apr 18, 2010 12:09 pm
by SaturdayAugust™
สวัสดีครับ คุณคนควน
ผมขอคำแนะนำอีกแล้วครับ ในกรณีที่ผมต้องการเขียน Script ขึ้นมาเพื่อสั่งให้ Excel File ถูกบันทึกลงไปใน Location ที่กำหนด เช่น
ผมส่ง e-mail โดยแนบ Excel File ไปให้ User และให้ User กดปุ่มเพื่อให้ Script ทำการสร้าง Folder ตามตำแหน่งดังนี้ครับ
"D:\Program\Master\File" แล้วจากนั้นก็สั่งให้ Excel File ถูกเก็บบันทึกลงใน Folder ดังกล่าวครับ ต้องทำอย่างไรครับ
ผมได้พยายามทำแล้ว แต่ไม่สำเร็จครับ ได้แต่เพียงว่า จะเอาไปบันทึกเก็บทีไ่หน โดยต้องสร้าง Folder รองรับไว้ก่อนเสมอน่ะครับ
รบกวนด้วยนะครับ
ขอบคุณครับ
Re: Macro | สร้าง Folder ใหม่ โดยใช้ Script
Posted: Sun Apr 18, 2010 2:44 pm
by snasui
ลองตาม Code ด้านล่างครับ
จะเป็นการตรวจสอบว่ามี Folder ที่ต้องการแล้วหรือไม่ ถ้ามีแล้วก็ทำการ Save ไฟล์ในชื่อ Test ถ้ายังไม่มีก็ให้สร้าง Folder ขึ้นมาก่อนแล้วก็ Save ไฟล์ในชื่อ Test
Code: Select all
Option Explicit
Function FolderExist(Path As String) As Boolean
On Error Resume Next
If Not Dir(Path, vbDirectory) = vbNullString Then
FolderExist = True
End If
On Error GoTo 0
End Function
Sub TestFolder()
If FolderExist("D:\Program\Master\File") Then
ChDir "D:\Program\Master\File"
ThisWorkbook.SaveAs ("Test.xls") 'Save file name as "Test"
Else
MkDir "D:\Program\Master\File"
ChDir "D:\Program\Master\File"
ThisWorkbook.SaveAs ("Test.xls") 'Save file name as "Test"
End If
End Sub
เวลาใช้งานให้เรียกใช้ TestFolder นะครับ
Re: Macro | สร้าง Folder ใหม่ โดยใช้ Script
Posted: Mon Apr 19, 2010 12:04 pm
by SaturdayAugust™
สวัสดีครับ คุณคนควน
ผมเอา Code ไป Run แล้วครับ พบว่ามี error บางประการครับ โดยผมได้แนบ File มาประกอบด้วยครับ
รบกวนนะครับ
ขอบคุณครับ
Re: Macro | สร้าง Folder ใหม่ โดยใช้ Script
Posted: Mon Apr 19, 2010 3:26 pm
by snasui
ลองใช้ Code ตามด้านล่างครับ
เป็นการสร้าง Folder หลักและย่อยตามลำดับ
Code: Select all
Option Explicit
Function FolderExist(Path As String) As Boolean
On Error Resume Next
If Not Dir(Path, vbDirectory) = vbNullString Then
FolderExist = True
End If
On Error GoTo 0
End Function
Sub TestFolder()
If FolderExist("D:\Program\Master\File") Then
ChDir "D:\Program\Master\File"
ThisWorkbook.SaveAs ("Test.xls") 'Save file name as "Test"
Else
On Error Resume Next
MkDir "D:\Program\"
MkDir "D:\Program\Master"
MkDir "D:\Program\Master\File"
ChDir "D:\Program\Master\File"
ThisWorkbook.SaveAs ("Test.xls") 'Save file name as "Test"
End If
End Sub