Page 1 of 1
Autosave excel file every 30 minute
Posted: Thu Apr 25, 2013 1:41 pm
by P1649
ระหว่างเวลาทำงานแต่ละวัน ต้องการ auto save excel file ตามตัวอย่างที่ลิงค์ โดยไม่รบกวนผู้ใช้งาน ชื่อไฟล์เป็น วัน-เวลา และกำหนดให้ autocave เวลา 10.00am-05.00pm ต้องแก้ไขอย่างไรบ้างครับ
http://www.tarwara.info/blog/automatic- ... 2007-2010/
http://www.mrexcel.com/forum/excel-ques ... sheet.html
ขอบคุณครับ
อมร
Re: Autosave excel file every 30 minute
Posted: Thu Apr 25, 2013 1:57 pm
by snasui
ควรแนบไฟล์ที่ลองทำตาม Link แล้วและยังติดปัญหามาด้วย ช่วยแจ้งด้วยว่าติดปัญหาที่บรรทัดใด หรือปัจจุบันผลเป็นเช่นไร ต้องการผลเป็นเช่นไรครับ
Re: Autosave excel file every 30 minute
Posted: Thu Apr 25, 2013 3:45 pm
by P1649
(code)
Public Const backupfolder As String = "C:\excelbackup\"
Sub Auto_Save()
If Dir(backupfolder, vbDirectory) = "" Then
' This will check if folder already exist
' If not then it will create new directory at first time
MkDir backupfolder
Call Save
' Save copy of Excel file to backupfolder
Else
Call Save
' If folder already exist then only save copy of Excel File
End If
End Sub
Function Save() As String
' Auto_save Macro
' This will create a copy of file at Seleted destination path
' Keyboard Shortcut: Ctrl+r
' Saves the current file to a backup folder
Dim savedate
savedate = Date ' Current system date
Dim savetime
savetime = Time ' Current system time
Dim formattime As String
formattime = Format(savetime, "hh.mm.ss")
Dim formatdate As String
formatdate = Format(savedate, "DD-MM-YYYY")
Application.DisplayAlerts = False
'
'Application.Run ("Auto_Save")
'
ActiveWorkbook.SaveCopyAs Filename:=backupfolder & formatdate & " " & formattime & " " & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
MsgBox "Backup Run. Please Check at: " & backupfolder
End Function
(code)
ต้องการให้ auto save ทุกๆ 30 นาที โดยไม่ต้องกด Ctrl+Q และทำงานระหว่างเวลา 10.00am-05.00pm
Re: Autosave excel file every 30 minute
Posted: Thu Apr 25, 2013 3:47 pm
by snasui
ช่วยแนบมาเป็นไฟล์ครับ จะได้ช่วยทดสอบได้ นอกจากนี้แล้วการโพสต์ Code ให้แสดงเป็น Code เพื่อสะดวกในการ Copy ไปทดสอบ ดูตัวอย่างได้ที่นี่ครับ
http://www.snasui.com/viewtopic.php?f=2&t=1187
Re: Autosave excel file every 30 minute
Posted: Thu Apr 25, 2013 7:06 pm
by P1649
Code: Select all
Public Const backupfolder As String = "C:\excelbackup\"
Sub Auto_Save()
If Dir(backupfolder, vbDirectory) = "" Then
' This will check if folder already exist
' If not then it will create new directory at first time
MkDir backupfolder
Call Save
' Save copy of Excel file to backupfolder
Else
Call Save
' If folder already exist then only save copy of Excel File
End If
End Sub
Function Save() As String
' Auto_save Macro
' This will create a copy of file at Seleted destination path
' Keyboard Shortcut: Ctrl+r
' Saves the current file to a backup folder
Dim savedate
savedate = Date ' Current system date
Dim savetime
savetime = Time ' Current system time
Dim formattime As String
formattime = Format(savetime, "hh.mm.ss")
Dim formatdate As String
formatdate = Format(savedate, "DD-MM-YYYY")
Application.DisplayAlerts = False
'
'Application.Run ("Auto_Save")
'
ActiveWorkbook.SaveCopyAs Filename:=backupfolder & formatdate & " " & formattime & " " & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
Beep
MsgBox "Backup Run. Please Check at: " & backupfolder
End Function
ต้องการให้ auto save ทุกๆ 30 นาที โดยไม่ต้องกด Ctrl+Q และทำงานระหว่างเวลา 10.00am-05.00pm
Re: Autosave excel file every 30 minute
Posted: Thu Apr 25, 2013 7:35 pm
by snasui
ไฟล์แนบที่มี Macro ควรเป็น .xlsm ไม่ใช่ .xlsx ครับ
ไฟล์ที่ส่งมาถามควรแนบ Code มาให้เรียบร้อยแล้วครับ
Re: Autosave excel file every 30 minute
Posted: Thu Apr 25, 2013 7:50 pm
by tupthai
Re: Autosave excel file every 30 minute
Posted: Thu Apr 25, 2013 8:26 pm
by P1649
เนื่องจากต้องการข้อมูลที่บันทึกทุกๆ 30 นาทีมาประมวลผล จึงไม่สามารถใช้คำสั่ง autosave/recovery ปกติได้
ไฟล์ทดสอบตามเอกสารแนบ ความต้องการเพิ่มเติมคือ
1. Autosave every 30 minute โดยไม่ต้องกด Ctrl+Q
2. Start 10.00am Finish 05.00pm
ขอบคุณครับ
Code: Select all
Public Const backupfolder As String = "C:\excelbackup\"
Sub Auto_Save()
If Dir(backupfolder, vbDirectory) = "" Then
' This will check if folder already exist
' If not then it will create new directory at first time
MkDir backupfolder
Call Save
' Save copy of Excel file to backupfolder
Else
Call Save
' If folder already exist then only save copy of Excel File
End If
End Sub
Function Save() As String
' Auto_save Macro
' This will create a copy of file at Seleted destination path
' Keyboard Shortcut: Ctrl+r
' Saves the current file to a backup folder
Dim savedate
savedate = Date ' Current system date
Dim savetime
savetime = Time ' Current system time
Dim formattime As String
formattime = Format(savetime, "hh.mm.ss")
Dim formatdate As String
formatdate = Format(savedate, "DD-MM-YYYY")
Application.DisplayAlerts = False
'
'Application.Run ("Auto_Save")
'
ActiveWorkbook.SaveCopyAs Filename:=backupfolder & formatdate & " " & formattime & " " & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
Beep
End Function
Re: Autosave excel file every 30 minute
Posted: Thu Apr 25, 2013 8:46 pm
by snasui
ไม่พบ Code ในไฟล์แนบครับ
Re: Autosave excel file every 30 minute
Posted: Fri Apr 26, 2013 10:53 pm
by P1649
ตัวอย่าง
Re: Autosave excel file every 30 minute
Posted: Fri Apr 26, 2013 11:28 pm
by snasui
Code ที่ Copy มาวางไม่ได้เป็น Statement ของ VBA
บรรทัดใดที่แสดงเป็นสีแดงแสดงว่าเป็นบรรทัดที่ Error จำเป็นต้องแก้ไขให้ไม่เป็นสีแดงก่อนครับ
ผู้ที่เคยเขียน VBA ควรทราบว่า Comment ของ VBA มีลักษณะอย่างไร ควรมีเครื่องหมายใดนำหน้า และตัวอักษรเป็นสีใด กรณีที่คุณ P1649 ไม่เคยเขียน VBA ผมแนะนำว่ายังไม่ควรใช้ VBA เพราะเมื่อผู้ตอบได้ตอบไปคุณก็ปรับใช้เองไม่เป็นอยู่ดีแม้การปรับนั้นเป็นแค่เล็ก ๆ น้อย ๆ
ถ้าจำเป็นต้องใช้ ให้ผู้ที่เขียนเป็นเขียนให้ ติดตรงไหนค่อยถามกัน สำหรับฟอรัมถามตอบนี้ผู้ที่ถามเกี่ยวกับ VBA
จำเป็นจะต้องมีความรู้เกียวกับ VBA มาบ้าง ต้องเขียนมาเองก่อนแล้วถามเฉพาะที่ติดปัญหาไม่ใช่ไม่เคยเขียนเลยครับ
Re: Autosave excel file every 30 minute
Posted: Sun Apr 28, 2013 2:59 pm
by P1649
ขอบคุณที่เป็นแรงบันดาลให้เรียนรู้ โค้ดข้างล่างให้งานได้แล้วครับ แต่อยากขอคำแนะนำเพิ่มเติม เรื่องการเขียน ต้องตั้งตัวแปร หรือแก้ไขอย่างไรให้กระชับ เหมาะสมกว่านี้ครับ
Final : Auto Save AS every 30 minutes with NO warning upon saving over the last copy.
__________
ThisWorkBook
Code: Select all
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime nTime, "SaveFile", , False
End Sub
Private Sub Workbook_Open()
Call SaveFile
End Sub
__________
Module1
Code: Select all
Public Const backupfolder As String = "D:\SETbackup\"
Public nTime As Double
Public Sub SaveFile()
With ThisWorkbook
nTime = Now + TimeSerial(0, 1, 0) 'every minute
If Dir(backupfolder, vbDirectory) = "" Then
MkDir backupfolder
.SaveCopyAs Filename:=backupfolder & (Format(Now, " yyyy-mm-dd, hh.mm.ss ")) & ActiveWorkbook.Name
Application.OnTime nTime, "SaveFile"
Else
.SaveCopyAs Filename:=backupfolder & (Format(Now, " yyyy-mm-dd, hh.mm.ss ")) & ActiveWorkbook.Name
Application.OnTime nTime, "SaveFile"
End If
End With
End Sub
Re: Autosave excel file every 30 minute
Posted: Sun Apr 28, 2013 3:09 pm
by snasui
Code นี้มีไม่กี่บรรทัด ตัวแปรก็ได้ประกาศไว้เรียบร้อยแล้ว ไม่ทราบว่าติดปัญหาใดครับ ถ้าไม่มีปัญหาไม่จำเป็นต้องปรับครับ
Re: Autosave excel file every 30 minute
Posted: Sun Apr 28, 2013 3:33 pm
by snasui
แนวทางในการปรับ สามารถลด Code ในส่วนของ If Statement ลงได้ ลองดูตัวอย่างด้านล่างครับ
Code: Select all
Public Const backupfolder As String = "D:\SETbackup\"
Public nTime As Double
Public Sub SaveFile()
With ThisWorkbook
nTime = Now + TimeSerial(0, 1, 0) 'every minute
If Dir(backupfolder, vbDirectory) = "" Then
MkDir backupfolder
End If
.SaveCopyAs Filename:=backupfolder & (Format(Now, _
" yyyy-mm-dd, hh.mm.ss ")) & ActiveWorkbook.Name
Application.OnTime nTime, "SaveFile"
End With
End Sub