Thanks for your response!
Note that if I try to use GoTo SKIP_FILE on an if
statement, the whole thing fails. The code is:
Public Function ExportToTemplates()
' Purpose: export data in database to history data sheet
in each template in the templates out directory
Dim dbs As Database, rst As Recordset, ls_sql As String
Dim xl As Object, Sheet As Object
Dim DBPath As String, FileName As String, ls_area As
String, ls_msg As String, FilePathName As String
Dim CurrentValue As Variant, CurrentField As Variant
Dim li_return As Integer, i As Integer, j As Integer,
iCols As Integer
Dim ls_destination As String
On Error GoTo SKIP_FILE
Set dbs = DBEngine.Workspaces(0).Databases(0)
ls_msg = "Place all spreadsheets in the Templates_Out
subdirectory and make sure they are all CLOSED."
li_return = MsgBox(ls_msg, vbOKCancel, "Double Check!")
If li_return = 1 Then
' establish link to Excel
Set xl = CreateObject("Excel.Application")
xl.Application.Visible = True
' get list of all xls files in Templates_Out
directory
DBPath = GetDatabasePath()
FileName = Dir(DBPath & "Templates_Out\*.xls")
Do Until FileName = ""
'Put If "div" file language in here
' open workbook and set sheet
FilePathName = DBPath & "Templates_Out\" &
FileName
xl.Application.Workbooks.Open FilePathName
' get area code
ls_area = xl.Application.Worksheets
("AREA").Range("C1").Value
ls_area = ls_area & xl.Application.Worksheets
("AREA").Range("C2").Value
xl.Application.Worksheets
("history_data").Activate
' delete data on history_data sheet
xl.Application.Worksheets
("history_data").Cells.ClearContents
' create history_data recordset of data to
export to excel
ls_sql = "SELECT * FROM tbl_history where
area_id = '" & ls_area & "' order by vlookup_key"
Set rst = dbs.OpenRecordset(ls_sql,
DB_OPEN_DYNASET)
' copy history_data from recordset to excel
For iCols = 0 To rst.Fields.Count - 1
xl.Application.Worksheets
("history_data").Cells(1, iCols + 1).Value = rst.Fields
(iCols).Name
Next
xl.Application.Worksheets("history_data").Range
("A2").CopyFromRecordset rst
' save, close, and move to _done
xl.Application.Workbooks(FileName).Close
SaveChanges:=True
ls_destination = DBPath
& "Templates_Out_Done\" & FileName
FileCopy FilePathName, ls_destination
Kill FilePathName
SKIP_FILE:
'If IsFileOpen(FilePathName) = -1 Then
' xl.Application.Workbooks(FileName).Close
SaveChanges:=False
'End If
' get the next file name from the list
FileName = Dir()
Loop
Set Sheet = Nothing
xl.Quit
Set xl = Nothing
DoCmd.SetWarnings True
li_return = MsgBox("All Done!", vbOK, "FYI")
End If
End Function
Thanks again!
Sandy
