Save as File แยกโดยที่ยัง Focus ไฟล์เดิม

[waritthorn]

ผมหาวิธีการเซฟไฟล์แยกเพื่อนำไฟล์ไปเก็บเป็น Backup
แต่ทุกครั้งที่ Save as ไฟล์ที่ทำอยู่จะไปแก้ไขเป็นไฟล์ที่บันทึกใหม่

ความต้องการคือ เซฟไฟล์ไปยังที่เก็บ ในขณะที่ทำงานไฟล์เก่าต่อไปได้ครับ

Code: Select all

Sub SaveBackup()
    Dim D As String
    D = "Backup " & Format(Date, "dd-mm-yy") & ".xlsm"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        "\\192.168.1.253\data\PR\Data PR\BackUp\" & D, FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Application.DisplayAlerts = True
End Sub

[logic]

Save เป็น 2 รอบก็น่าจะได้ครับ

Code: Select all

Sub SaveBackup()
    Dim D As String, E As String
    D = "Backup " & Format(Date, "dd-mm-yy") & ".xlsm"
    E = "Backup " & Format(Date, "dd-mm-yy") & "_backup.xlsm"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        "\\192.168.1.253\data\PR\Data PR\BackUp\" & E, FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWorkbook.SaveAs Filename:= _
        "\\192.168.1.253\data\PR\Data PR\BackUp\" & D, FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Application.DisplayAlerts = True
End Sub

จะเซฟเป็นไฟล์เก่าก็เซฟเป็นแบ็คอัพก่อนแล้วค่อยเซฟกับมาเป็นชื่อเก่า

[Bo_ry]

Copy

Code: Select all

Sub SaveBackup()
Dim D As String, FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    D = "Backup " & Format(Date, "dd-mm-yy") & ".xlsm"
    ActiveWorkbook.Save
    FSO.CopyFile ActiveWorkbook.FullName, "\\192.168.1.253\data\PR\Data PR\BackUp\" & D
End Sub

[snasui]

อีกตัวอย่างครับ

Code: Select all

Sub SaveBackup()
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveCopyAs  _
        "\\192.168.1.253\data\PR\Data PR\BackUp\Backup " & Format(Date, "dd-mm-yy") & ".xlsm"
    Application.DisplayAlerts = True
End Sub

[waritthorn]

ขอบคุณทุกคนมากครับ

สามารถนำมาปรับใช้กับงานได้เลยครับ
ขอบคุณที่ชี้แนะครับ