การ Backup และ Restore MS Access ด้วย MS Visual Basic 6.0

' ===================================================================
' โครงสร้างชนิดข้อมูลที่ต้องนำมาใช้กับ Function SHFileOperation
Private Type SHFILEOPSTRUCT
     ' อันนี้ให้ไปดูที่ APIFileCopy น่าจะเข้าใจได้ง่ายกว่าครับ
     hWnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Integer
     fAnyOperationsAborted As Boolean
     hNameMappings As Long
     lpszProgressTitle As String
End Type

' ===================================================================
' การ Copy, Move, Rename หรือ Delete  เกี่ยวกับ File System Object
' โดยการกำหนดผ่านทาง wFunc ใน SHFILEOPSTRUCT
' หากทำงานสำเร็จก็จะส่งค่า 0 กลับมา (Return) ... หากไม่สำเร็จก็จะเป็นค่าที่ไม่ใช่ 0
' แล้วผมมาบอกทำไมล่ะ ... ก็เพราะจะเอาค่านี้ไปตรวจสอบว่ามันเกิดข้อผิดพลาดหรือไม่ไงล่ะครับพี่น้อง
' ลองไปดูในเหตุการณ์ cmdBackup_Click ใน frmBackupRestore ดูกันเอาเถิดครับผม
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" ( _
        lpFileOp As SHFILEOPSTRUCT) _
        As Long
        
Public Const FO_COPY = &H2  ' ค่าคงที่ของการคัดลอกข้อมูล
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_NOCONFIRMATION = &H10  ' เขียนทับไฟล์เดิมทันที ... ไม่ต้องถาม

' ===================================================================
' ตัวอย่างเดิมครั้งกระโน้นผมทำเป็น Sub Program ... 
' แต่งานนี้ต้องอาศัยฟังค์ชั่น เพื่อให้เกิดการ Return ค่า Error กลับได้
' อย่าลืมน่ะครับ ... ทำงานสำเร็จเท่านั้นมันจะ Return ค่ากลับเป็น 0 
Public Function APIFileCopy(SourceFile As String, DestinationFile As String) As Long
     
     Dim typFileOperation As SHFILEOPSTRUCT

     With typFileOperation
        .hWnd = 0
        ' ทำการคัดลอกข้อมูล
        .wFunc = FO_COPY
        .pFrom = SourceFile & vbNullChar & vbNullChar ' ต้นทาง (Source File)
        .pTo = DestinationFile & vbNullChar & vbNullChar ' ปลายทาง (Destination file)
        
        ' FOR_NOCONFIRMATION คือ จะไม่เตือนหากชื่อไฟล์ซ้ำกันน่ะครับพี่น้อง
        ' หากนำมาใช้ ... จึงอนุญาตให้เขียนทับไฟล์ลงไปได้เลย
        .fFlags = FOF_NOCONFIRMATION + FOF_ALLOWUNDO
     End With
     
     ' Return ค่ากลับเพื่อแจ้งสถานะของการจัดการกับไฟล์ข้อมูล
     APIFileCopy = SHFileOperation(typFileOperation)
End Function


' ส่วนของการเรียกใช้งานมาจาก frmBackupRestore
' ============================================================
' เริ่มต้นทำการคัดลอกข้อมูล ... Copy ผ่านทาง API
' หาก Return ค่าจาก APIFileCopy ไม่ใช่ 0 นั่นคือมี Error เกิดขึ้น
ErrorNumber = APIFileCopy(SourceDir, Destination)
' ============================================================

' มี Error เกิดขึ้น ... ErrorNumber จะไม่เท่ากับ 0
If ErrorNumber <> 0 Then
    ........................
' ไม่มี Error
Else
    ........................
End If

Private Sub cmdBackup_Click()
Dim SourceDir As String ' ตำแหน่งต้นทาง
Dim SourceFile As String    ' ไฟล์ที่ต้องการ
Dim Destination As String   ' ตำแหน่งและไฟล์ปลายทาง

' ส่วนของการทำ Logging File โดยการเรียกใช้งานผ่านทาง
' Project --> Preferences --> Microsoft Scripting Runtime
Dim MyFSO As New FileSystemObject, LoggingFile
Dim LogStream As TextStream

' เก็บค่า Return จากการสั่งให้คัดลอกไฟล์ผ่านทาง API
Dim ErrorNumber As Long


' ============================================================
'On Error GoTo ErrHandler
' ไม่จำเป็นต้องใช้เพราะ APIFileCopy(SourceDir, Destination) จะคืนค่ากลับว่าทำงานสำเร็จหรือไม่
' หากไม่สำเร็จมันจะใช้ Error ของระบบปฏิบัติการ (ผ่านทาง API) แจ้งเข้ามาครับ ... พี่น้อง

If File1.FileName = "" Then
    MsgBox "กรุณาเลือกไฟล์ต้นฉบับที่ต้องการจะทำการสำรองข้อมูลให้เรียบร้อยก่อนด้วย.", vbOKOnly + vbInformation, "รายงานสถานะ"
    Exit Sub
End If

If chkAutoBackup = vbChecked Then
    ' ตั้งค่าเวลาขั้นต่ำไว้ที่ 1 นาที
    If txtMin.Text = "0" Or txtMin.Text = "" Or Len(txtMin.Text) = 0 Then txtMin.Text = "1"
End If

SourceFile = File1.FileName

' หากเป็น Root Firectory มันจะได้ "C:\" คือมี \ ต่อท้ายมา แต่ถ้าหากไม่ใช่ก็จะได้ "C:\VB"
' ดังนั้นแบบตัวหลังเราจึงจำเป็นต้องเพิ่มเครื่องหมาย \ เข้าไปอีกไงครับพี่น้อง
If Right$(Dir1, 1) <> "\" Then
    SourceDir = Dir1.Path & "\" & SourceFile
Else
    SourceDir = Dir1.Path & SourceFile
End If

' Option เพิ่มเติม หากต้องการให้สำรองข้อมูลแยกไฟล์เดิมด้วยการเติมวันที่ลงไปตามหลังไฟล์
If chkFilenameDate.Value = vbChecked Then
    ' โดยตัดความยาวของไฟล์ต้นฉบับออกไป 4 ตัวท้ายสุด ... Left$(SourceFile, Len(SourceFile) - 4) เช่น
    ' MyDataBase.MDB ก็จะถูกตัดเหลือ MyDataBase ส่วน .MDB จะถูกตัดออกไปก่อน
    ' จากนั้นตามหลังด้วยค่าของ วัน เดือน ปี ชั่วโมง นาที
    ' แล้วค่อยใช้ Right$(SourceFile, 4) มาเชื่อมต่ออีกครั้ง เพื่อให้ไฟล์ครบทั้งชื่อ และ นามสกุล
    ' เช่น MyDataBase-01-01-2551-12-20.mdb
    SourceFile = Left$(SourceFile, Len(SourceFile) - 4) & "-" & _
                                        Format(Now, "dd-mm-yy-hh-mm") & Right$(SourceFile, 4)
End If

' รวมตำแหน่ง และ ชื่อไฟล์เข้าด้วยกัน
If Right$(Dir2, 1) <> "\" Then    '  แสดงว่าไม่ใช่ Root Directory ดังนั้นต้องเพิ่ม \ เข้าไป
    Destination = Dir2.Path & "\" & SourceFile
Else
    Destination = Dir2.Path & SourceFile
End If

' ====================== ทำ Logging File ========================
' ตรวจสอบชื่อไฟล์ว่ามีอยู่ในตำแหน่งปัจจุบันหรือไม่ โดยใช้คำสั่ง Dir เข้าช่วย
If Dir(ApplicationDir & "Logging.txt") = "" Then
    ' กรณีที่หาไม่เจอ จะทำการสร้างไฟล์ชื่อ Logging.txt ขึ้นมาใหม่
    Set LoggingFile = MyFSO.CreateTextFile(ApplicationDir & "Logging.txt", True)
End If

Set LoggingFile = MyFSO.GetFile(ApplicationDir & "Logging.txt")
 ' เมื่อเจอไฟล์ที่ต้องการก็ทำการบันทึกข้อมูลลงไปต่อท้ายไฟล์เลย (ForAppending)
Set LogStream = LoggingFile.OpenAsTextStream(ForAppending)
' ============================================================

' ============================================================
' เริ่มต้นทำการคัดลอกข้อมูล ... Copy ผ่านทาง API
' หาก Return ค่าจาก APIFileCopy ไม่ใช่ 0 นั่นคือมี Error เกิดขึ้น
ErrorNumber = APIFileCopy(SourceDir, Destination)
' ============================================================

' มี Error เกิดขึ้น ... ErrorNumber จะไม่เท่ากับ 0
If ErrorNumber <> 0 Then
    LogStream.WriteLine "การสำรองข้อมูลเมื่อ: " & Now()
    LogStream.WriteLine "---------------------------------  เกิดความผิดพลาด  ------------------------------------"
    LogStream.WriteLine "รหัสผิดพลาด: " & ErrorNumber
    LogStream.WriteLine
' ไม่มี Error
Else
    File2.Refresh
    LogStream.WriteLine "--------------------------------- เริ่มการสำรองข้อมูล ------------------------------------"
    LogStream.WriteLine "การสำรองข้อมูลเมื่อ: " & Now()
    LogStream.WriteLine "สำรองข้อมูล: " & SourceDir & " ไปเก็บไว้ที่ " & Destination
    LogStream.WriteLine "--------------------------------- สิ้นสุดการสำรองข้อมูล ---------------------------------"
    LogStream.WriteLine
    MsgBox "การสำรองข้อมูล - Backup Database" & vbCrLf & _
                    "จาก: " & SourceDir & vbCrLf & _
                    "ไป: " & Destination & vbCrLf & _
                    "เรียบร้อยสมบูรณ์.", vbOKOnly + vbInformation, "รายงานสถานะ"
End If
End Sub

' การสั่งให้สำรองข้อมูลแบบอัตโนมัติ ตามระยะเวลาที่กำหนด (นาที)
Private Sub chkAutoBackup_Click()
    If chkAutoBackup.Value = vbChecked Then
        Timer2.Enabled = True
        ' กระตุ้น (Trigger) นาฬิกาทุกๆ 1 นาที
        Timer2.Interval = 60000
    Else
        Timer2.Enabled = False
        CountTime = 0
    End If
End Sub

Private Sub Timer2_Timer()
    ' CountTime จะเพิ่มขึ้นทุกๆ 1 นาที
    ' มันก็มาจากการตั้งค่า Timer2.Interval = 60000 หรือ 60 วินาที หรือ 1 นาทีนั่นไงครับ ... พี่น้อง
    CountTime = CountTime + 1
    
    ' หากครบกำหนดระยะเวลาตามที่ระบุไว้ ก็จะเริ่มกระบวนการสำรองข้อมูล
    If CountTime >= Val(txtMin.Text) Then
        CountTime = 0
        Call cmdBackup_Click
    End If
End Sub

' ===================================================================
' API ที่ผมต้องการใช้แสดงข้อมูลใน Logging File
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
        ByVal hWnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) _
        As Long
Public Const SW_SHOW = 5    ' ค่าคงที่ที่ใช้ในการเปิดไฟล์เพื่อทำการแสดงผล

Private Sub cmdLogFile_Click()
    ' เรียกใช้งาน ShellExecute - API เพื่อทำการเปิด (Open) ไฟล์ Logging.txt
    ' อะไรมันจะง่ายดายปานนั้น ... โหอย่างนี้ต้องคิดตังค์ค่างานเพิ่มอีก 99 บาท ... 55555
    ShellExecute hWnd, "Open", ApplicationDir & "Logging.txt", vbNullString, vbNullString, SW_SHOW
End Sub

' เริ่มต้นด้วยการตั้งค่าต่างๆแบบ Run Time (เห็นผลเมื่อสั่งให้โปรแกรมทำงาน)
Sub InitializeData()
    Drive1.Drive = "C"
    Drive2.Drive = "C"
    
    ' ตั้งค่า Pattern ของไฟล์ เอาเฉพาะ MS Access DataBase
    File1.Pattern = "*.mdb"
    File2.Pattern = "*.mdb"

    ' ป้องกันปัญหาเรื่องของ Path ที่ไม่ใช่ Root Directory
    If Not Right$(App.Path, 1) = "\" Then ApplicationDir = App.Path & "\"
End Sub

' โค้ดอยู่ใน Sub cmdRestore_Click()
' ============================================================
' กรณีที่ต้องการเปลี่ยนชื่อไฟล์ก่อน
' ============================================================
If MsgBox("คุณต้องการเปลี่ยนชื่อไฟล์ก่อนหรือไม่?" & vbCrLf & _
                    "เลือก [Yes] เมื่อต้องการ หรือ " & vbCrLf & _
                    "เลือก [No] เมื่อต้องการทำงานต่อ.", vbYesNo + vbQuestion + vbDefaultButton2, _
                    "สอบถามการเปลี่ยนชื่อไฟล์") = vbYes Then
    
    RenameFile = InputBox("เปลี่ยนชื่อไฟล์ฐานข้อมูลโดยไม่ต้องใส่นามสกุล", "ป้อนชื่อไฟล์", _
             Left$(SourceFile, Len(SourceFile) - 4))
    ' ตรวจสอบว่ามีการส่งค่ามาจาก InputBox (แล้วเก็บไว้ในตัวแปร RenameFile) หรือไม่ ... หากใช่ RenameFile จะมีความยาวมากกว่า 0
    If Trim(RenameFile) <> "" Or Len(Trim(RenameFile)) > 0 Then
        ' ต้องไม่มีเครื่องหมาย . หากมีการป้อนเข้ามาก็ให้ออกจากโปรแกรมย่อยไปเลย
        If InStr(RenameFile, ".") Then
            MsgBox "ไม่อนุญาตให้ป้อนเครื่องหมาย . ", vbOKOnly + vbInformation, "รายงานความผิดพลาด"
            Exit Sub
        Else
            SourceFile = RenameFile & ".mdb"
        End If
    Else
        ' ผู้ใช้งานกดปุ่ม Cancel เพื่อยกเลิกจาก InputBox ดังนั้นเพื่อสนองตอบผู้ใช้งานก็ควรให้ออกจากโปรแกรมย่อยนี้ไปก่อน
        Exit Sub
    End If
End If
' ============================================================