ช่วยดูโค้ด vba ต้องแก้ไขตรงไหนครับ

[mepmep]

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 BUandSave2()

Dim MyDate
Dim MyTime
Dim TestStr As String
Dim Test1Str As String
Dim Newfolder As String
Dim backupfile As String

MyDate = Date    ' MyDate contains the current system date.
MyTime = Time    ' Return current system time.
TestStr = Format(MyTime, "hh.mm.ss")
Test1Str = Format(MyDate, "DD-MM-YYYY")

backupfile = Test1Str & " " & TestStr & " " & ActiveWorkbook.Name

Newfolder = ActiveWorkbook.Path & "\Backup_Test"

If FolderExist(Newfolder) Then
	MsgBox "Exist folder " & Newfolder
	ChDir Newfolder
	ThisWorkbook.SaveAs backupfile
	ActiveWorkbook.Save
	Application.DisplayAlerts = True

	Else
		MsgBox "Not exist folder " & Newfolder
		MkDir Newfolder
		ChDir Newfolder
		ThisWorkbook.SaveAs backupfile
		ActiveWorkbook.Save
		Application.DisplayAlerts = True
End If
End Sub

คือ โค้ดน่าจะโอเค แต่ติดตอนพอกดรัน ไฟล์ที่ใช้อยู่ เปลี่ยนชื่อใหม่ด้วย ผมต้องแก้ไขตรงไหน
*** แค่ต้องการแบ็คอัพ ลงfolder backup_test ก็อปปี้ไป เปลี่ยนชื่อเป็น วัน เวลา ชื่อไฟล์เดิม นะครับ
ขอบคุณครับ

[snasui]

ส่งไฟล์มาด้วยจะได้ช่วยทดสอบครับ Code นี้เขียนเองหรือได้มาจากไหนเพื่อจะได้ช่วยดูว่ามี Comment อะไรเพิ่มเติมจากผู้เขียนหรือไม่ประกอบด้วยครับ

[mepmep]

โค้ดก็โค้ดของอาจารย์ละครับ กับของเว็บต่างประเทศ ผมเอายำยำกัน

พอดี จะสร้างปุ่มไว้สำหรับก็อปสำรองไฟล์ ในงานที่ออฟฟิสนะครับ

http://snasui.wordpress.com/2011/01/31/ ... B9%89-vba/
http://stackoverflow.com/questions/2833 ... p-location

[snasui]

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

สมมุติว่าต้องการเก็บไฟล์สำรองไว้ที่ D:\Test_File\Backup_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 BUandSave()
Dim MyDate As Date, MyTime As Date
Dim TestStr As String, Test1Str As String
Dim Newfolder As String, backupfile As String
Dim CurFd As String

CurFd = "D:\Test_File"
MyDate = Date    ' MyDate contains the current system date.
MyTime = Time    ' Return current system time.
TestStr = Format(MyTime, "hh.mm.ss")
Test1Str = Format(MyDate, "DD-MM-YYYY")

backupfile = Test1Str & " " & TestStr & " " & "TestCopyNewFile.xls"

Newfolder = CurFd & "\Backup_Test"
ChDir CurFd
If FolderExist(Newfolder) Then
    MsgBox "Exist folder " & Newfolder
    ChDir Newfolder
    ThisWorkbook.SaveAs backupfile
Else
    MsgBox "Not exist folder " & Newfolder
    MkDir Newfolder
    ChDir Newfolder
    ThisWorkbook.SaveAs backupfile
End If
End Sub