Sub Refresh()
'On Error GoTo Refresh_err
Const ForAppending = 8
Dim f, fs
Sheet1.Unprotect "hmx"
Call ADOImportFromAccessTable(strDBPath, "V_EXCEL_EXPORT", Cells(19, 1))
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.opentextfile(strLogPath, ForAppending, True, TristateUseDefault)
Set f = fs.GetFile(strLogPath)
If f.Size > 250000 Then
fs.copyfile strLogPath, strLogPath & Date & ".log"
fs.deletefile strLogPath
End If
Set f = fs.opentextfile(strLogPath, ForAppending, True, TristateUseDefault)
f.Write Date & " - " & Time & " - " & "Everything OK" & vbCrLf
f.Close
Sheet1.Protect "hmx"
Refresh_err:
Exit Sub
End Sub
Sub RefreshCurrent()
'On Error GoTo RefreshCurrent_Err
Application.OnTime Now + TimeValue("00:00:05"), "RefreshCurrent"
Sheet1.Unprotect "hmx"
Range("G8:S10").Calculate
Range("A8:A8").Calculate
Range("A30:A30").Calculate
Range("B74:B74").Calculate
Range("B76:B76").Calculate
Range("B78:B78").Calculate
Call Refresh
Sheet1.Protect "hmx"
RefreshCurrent_Err:
Exit Sub
End Sub
ADOImportFromAccessTable_Err:
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.opentextfile(strErrLogPath, ForAppending, True, TristateUseDefault)
Set f = fs.GetFile(strErrLogPath)
If f.Size > 250000 Then
fs.copyfile strErrLogPath, strErrLogPath & Date & ".old"
fs.deletefile strErrLogPath
End If
Set f = fs.opentextfile(strErrLogPath, ForAppending, True, TristateUseDefault)
f.Write Date & " - " & Time & " - " & Err.number & " - " & Err.Description & vbCrLf
f.Close
'Sheet1.Calculate
'myType = TypeName(Cells(8, 1).Value)
CheckCell = IsError(Cells(8,
.Value)
If CheckCell = True Then
If frmClose.Visible = False Then frmClose.Show 'By checking if it's visible... you get the picture
End If
Resume ADOImportFromAccessTable_exit
End Sub