Exporting to Access Help needed

J

Justin

I have this database where the data from a table is needed to be exported .
Now I someone gave me a code that will open an preexisting excel sheet and
place all the data there. I love this code but the only problem is that this
code just keeps adding data to that excel sheet. I need a way to have like a
save dialog box appear, so that user will be able to save the file, so the
next time they run this, it won't keep adding. Please help.
here is the code I got::

*****

Private Sub cmdExport_Click()
On Error GoTo LocalError

Dim WhereTo As String
Dim ProjectID As String
Dim rsClaimBreakDown As DAO.Recordset
Dim NoOfRecords As Integer
Dim NoOfWorksheets As Integer

If IsNull(Me.txtStartDate) Or IsNull(Me.txtEndDate) Then
MsgBox "Cannot continue, data missing from Start/End Date boxes. Please fill
out before continuing!", vbOKOnly, "Data Capture Error"
txtStartDate.SetFocus
Exit Sub
End If

WhereTo = GetExportDirectory_Excel 'Open the save to dialog box

If WhereTo = "NoFile" Then Exit Sub

ProjectID = "WS"

DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM TempTbl_WorkstepClaimData")
DoCmd.RunSQL ("INSERT INTO TempTbl_WorkstepClaimData ( ClientSurname,
ClientFirstname, ClientNINumber, StartDate, CEHours, EndDate,
ReasonForLeaving, ProgressionDate, SustainedProgressionDate, PlanDate) " & _
"SELECT DISTINCTROW tbl_Client.ClientSurname, tbl_Client.ClientFirstname,
tbl_Client.ClientNINumber, Tbl_Projects.StartDate,
Tbl_CurrentEmployers.CEHours, Tbl_Projects.EndDate,
Tbl_CurrentEmployers.ReasonForLeaving, Tbl_CurrentEmployers.ProgressionDate,
Tbl_CurrentEmployers.SustainedProgressionDate, Tbl_DevPlan.PlanDate " & _
"FROM ((Tbl_Projects INNER JOIN tbl_Client ON Tbl_Projects.ClientID =
tbl_Client.ClientID) LEFT JOIN Tbl_CurrentEmployers ON tbl_Client.ClientID =
Tbl_CurrentEmployers.ClientID) LEFT JOIN Tbl_DevPlan ON tbl_Client.ClientID =
Tbl_DevPlan.ClientID " & _
"WHERE (((Tbl_Projects.ProjectRef)='" & ProjectID & "'));")
DoCmd.SetWarnings True

Set rsClaimBreakDown = CurrentDb.OpenRecordset("TempTbl_WorkstepClaimData")

With rsClaimBreakDown
..MoveLast
NoOfRecords = rsClaimBreakDown.RecordCount
..MoveFirst
End With


'================================================= =====
'Insert the data from the temptable to the excel sheet
'================================================= =====

Dim CellRef As Integer
Dim NoOfLoops As Integer

openexcel (WhereTo) 'Gets the location of the template
xl.UserControl = False 'Doesnt allow user any control whilst we run our update
xl.Worksheets(2).Select 'Selects the claim breakdown sheet

'This section inserts the correct number of rows into the body of the
spreadsheet
NoOfLoops = NoOfRecords - 1
Do Until NoOfLoops = 0
xl.Rows("16:16").Select
xl.Selection.Insert Shift:=xlDown
xl.Rows("15:15").Select
xl.Selection.Copy 'need to copy the forumlas too, so cant just insert new rows
xl.Rows("16:16").Select
xl.ActiveSheet.Paste
xl.Application.CutCopyMode = False 'takes the flashing cell thing away
NoOfLoops = NoOfLoops - 1
Loop

'Insert the dates
xl.Range("C8").Value = Forms![Frm_Workstep]!txtStartDate
xl.Range("B10").Value = Forms![Frm_Workstep]!txtWeeks
xl.Range("E8").Value = Forms![Frm_Workstep]!txtEndDate

'This Loop section inserts the Data
CellRef = 15 'Starts at 15 because that is the start of the area i want to
insert into
NoOfLoops = NoOfRecords
With rsClaimBreakDown
..MoveFirst
Do Until NoOfLoops = 0
xl.Range("A" & CellRef & "").Value = rsClaimBreakDown![ClientSurname]
xl.Range("B" & CellRef & "").Value = rsClaimBreakDown![ClientFirstName]
xl.Range("C" & CellRef & "").Value = rsClaimBreakDown![ClientNINumber]
xl.Range("E" & CellRef & "").Value = rsClaimBreakDown![StartDate]
xl.Range("F" & CellRef & "").Value = rsClaimBreakDown![CEHours]
xl.Range("H" & CellRef & "").Value = rsClaimBreakDown![EndDate]
xl.Range("I" & CellRef & "").Value = rsClaimBreakDown![ReasonForLeaving]
xl.Range("S" & CellRef & "").Value = rsClaimBreakDown![ProgressionDate]
xl.Range("T" & CellRef & "").Value =
rsClaimBreakDown![SustainedProgressionDate]
xl.Range("Q" & CellRef & "").Value = rsClaimBreakDown![PlanDate]
CellRef = CellRef + 1
NoOfLoops = NoOfLoops - 1
..MoveNext
Loop
End With

xl.UserControl = True 'Give control back to the user
rsClaimBreakDown.CLOSE

MsgBox "Export to Claim Form completed successfully!", vbOKOnly, "Export
Completed"
DoCmd.CLOSE A_FORM, "Frm_Workstep"
xl.Visible = True

LocalExit:
Set xl = Nothing
Set rsClaimBreakDown = Nothing
Exit Sub

LocalError:
MsgBox Err.Number & vbCr & vbCr & Err.Description
Resume LocalExit

End Sub
---------------------
Openexcel Function:

Option Compare Database
Option Explicit

Public xl As Object 'This is how you will refer to the object once it is open

Function openexcel(strLocation)

Set xl = CreateObject("Excel.Application")

xl.Visible = False 'Makes the spreasheet visible. False will let you open
'it behind the scenes

xl.Workbooks.Open strLocation
'xl.Workbooks.Add 'Will Create a new workbook
End Function
 
K

Klatuu

I see you already have an open dialog to select the file. Can you modify it
to save a file? If not, here is a link to a very useful Open/Save API that
will do that for you. Once you are ready to do the export, call with the
Save and the user can pick a place to put it and a name to save it under.
You can also set a flag to warn the user if they are trying to save over an
existing file of the same name.

Justin said:
I have this database where the data from a table is needed to be exported .
Now I someone gave me a code that will open an preexisting excel sheet and
place all the data there. I love this code but the only problem is that this
code just keeps adding data to that excel sheet. I need a way to have like a
save dialog box appear, so that user will be able to save the file, so the
next time they run this, it won't keep adding. Please help.
here is the code I got::

*****

Private Sub cmdExport_Click()
On Error GoTo LocalError

Dim WhereTo As String
Dim ProjectID As String
Dim rsClaimBreakDown As DAO.Recordset
Dim NoOfRecords As Integer
Dim NoOfWorksheets As Integer

If IsNull(Me.txtStartDate) Or IsNull(Me.txtEndDate) Then
MsgBox "Cannot continue, data missing from Start/End Date boxes. Please fill
out before continuing!", vbOKOnly, "Data Capture Error"
txtStartDate.SetFocus
Exit Sub
End If

WhereTo = GetExportDirectory_Excel 'Open the save to dialog box

If WhereTo = "NoFile" Then Exit Sub

ProjectID = "WS"

DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM TempTbl_WorkstepClaimData")
DoCmd.RunSQL ("INSERT INTO TempTbl_WorkstepClaimData ( ClientSurname,
ClientFirstname, ClientNINumber, StartDate, CEHours, EndDate,
ReasonForLeaving, ProgressionDate, SustainedProgressionDate, PlanDate) " & _
"SELECT DISTINCTROW tbl_Client.ClientSurname, tbl_Client.ClientFirstname,
tbl_Client.ClientNINumber, Tbl_Projects.StartDate,
Tbl_CurrentEmployers.CEHours, Tbl_Projects.EndDate,
Tbl_CurrentEmployers.ReasonForLeaving, Tbl_CurrentEmployers.ProgressionDate,
Tbl_CurrentEmployers.SustainedProgressionDate, Tbl_DevPlan.PlanDate " & _
"FROM ((Tbl_Projects INNER JOIN tbl_Client ON Tbl_Projects.ClientID =
tbl_Client.ClientID) LEFT JOIN Tbl_CurrentEmployers ON tbl_Client.ClientID =
Tbl_CurrentEmployers.ClientID) LEFT JOIN Tbl_DevPlan ON tbl_Client.ClientID =
Tbl_DevPlan.ClientID " & _
"WHERE (((Tbl_Projects.ProjectRef)='" & ProjectID & "'));")
DoCmd.SetWarnings True

Set rsClaimBreakDown = CurrentDb.OpenRecordset("TempTbl_WorkstepClaimData")

With rsClaimBreakDown
.MoveLast
NoOfRecords = rsClaimBreakDown.RecordCount
.MoveFirst
End With


'================================================= =====
'Insert the data from the temptable to the excel sheet
'================================================= =====

Dim CellRef As Integer
Dim NoOfLoops As Integer

openexcel (WhereTo) 'Gets the location of the template
xl.UserControl = False 'Doesnt allow user any control whilst we run our update
xl.Worksheets(2).Select 'Selects the claim breakdown sheet

'This section inserts the correct number of rows into the body of the
spreadsheet
NoOfLoops = NoOfRecords - 1
Do Until NoOfLoops = 0
xl.Rows("16:16").Select
xl.Selection.Insert Shift:=xlDown
xl.Rows("15:15").Select
xl.Selection.Copy 'need to copy the forumlas too, so cant just insert new rows
xl.Rows("16:16").Select
xl.ActiveSheet.Paste
xl.Application.CutCopyMode = False 'takes the flashing cell thing away
NoOfLoops = NoOfLoops - 1
Loop

'Insert the dates
xl.Range("C8").Value = Forms![Frm_Workstep]!txtStartDate
xl.Range("B10").Value = Forms![Frm_Workstep]!txtWeeks
xl.Range("E8").Value = Forms![Frm_Workstep]!txtEndDate

'This Loop section inserts the Data
CellRef = 15 'Starts at 15 because that is the start of the area i want to
insert into
NoOfLoops = NoOfRecords
With rsClaimBreakDown
.MoveFirst
Do Until NoOfLoops = 0
xl.Range("A" & CellRef & "").Value = rsClaimBreakDown![ClientSurname]
xl.Range("B" & CellRef & "").Value = rsClaimBreakDown![ClientFirstName]
xl.Range("C" & CellRef & "").Value = rsClaimBreakDown![ClientNINumber]
xl.Range("E" & CellRef & "").Value = rsClaimBreakDown![StartDate]
xl.Range("F" & CellRef & "").Value = rsClaimBreakDown![CEHours]
xl.Range("H" & CellRef & "").Value = rsClaimBreakDown![EndDate]
xl.Range("I" & CellRef & "").Value = rsClaimBreakDown![ReasonForLeaving]
xl.Range("S" & CellRef & "").Value = rsClaimBreakDown![ProgressionDate]
xl.Range("T" & CellRef & "").Value =
rsClaimBreakDown![SustainedProgressionDate]
xl.Range("Q" & CellRef & "").Value = rsClaimBreakDown![PlanDate]
CellRef = CellRef + 1
NoOfLoops = NoOfLoops - 1
.MoveNext
Loop
End With

xl.UserControl = True 'Give control back to the user
rsClaimBreakDown.CLOSE

MsgBox "Export to Claim Form completed successfully!", vbOKOnly, "Export
Completed"
DoCmd.CLOSE A_FORM, "Frm_Workstep"
xl.Visible = True

LocalExit:
Set xl = Nothing
Set rsClaimBreakDown = Nothing
Exit Sub

LocalError:
MsgBox Err.Number & vbCr & vbCr & Err.Description
Resume LocalExit

End Sub
---------------------
Openexcel Function:

Option Compare Database
Option Explicit

Public xl As Object 'This is how you will refer to the object once it is open

Function openexcel(strLocation)

Set xl = CreateObject("Excel.Application")

xl.Visible = False 'Makes the spreasheet visible. False will let you open
'it behind the scenes

xl.Workbooks.Open strLocation
'xl.Workbooks.Add 'Will Create a new workbook
End Function
Click to expand...
 
J

Justin

thanks, can you tell me that link, i dont see it. also can you tell me how to
add that flag and one other thing
The excel sheet (the template one) has 3 extra rows, that has to be added to
all rows where the data is placed. How can i do that automatically

Klatuu said:
I see you already have an open dialog to select the file. Can you modify it
to save a file? If not, here is a link to a very useful Open/Save API that
will do that for you. Once you are ready to do the export, call with the
Save and the user can pick a place to put it and a name to save it under.
You can also set a flag to warn the user if they are trying to save over an
existing file of the same name.

Justin said:
I have this database where the data from a table is needed to be exported .
Now I someone gave me a code that will open an preexisting excel sheet and
place all the data there. I love this code but the only problem is that this
code just keeps adding data to that excel sheet. I need a way to have like a
save dialog box appear, so that user will be able to save the file, so the
next time they run this, it won't keep adding. Please help.
here is the code I got::

*****

Private Sub cmdExport_Click()
On Error GoTo LocalError

Dim WhereTo As String
Dim ProjectID As String
Dim rsClaimBreakDown As DAO.Recordset
Dim NoOfRecords As Integer
Dim NoOfWorksheets As Integer

If IsNull(Me.txtStartDate) Or IsNull(Me.txtEndDate) Then
MsgBox "Cannot continue, data missing from Start/End Date boxes. Please fill
out before continuing!", vbOKOnly, "Data Capture Error"
txtStartDate.SetFocus
Exit Sub
End If

WhereTo = GetExportDirectory_Excel 'Open the save to dialog box

If WhereTo = "NoFile" Then Exit Sub

ProjectID = "WS"

DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM TempTbl_WorkstepClaimData")
DoCmd.RunSQL ("INSERT INTO TempTbl_WorkstepClaimData ( ClientSurname,
ClientFirstname, ClientNINumber, StartDate, CEHours, EndDate,
ReasonForLeaving, ProgressionDate, SustainedProgressionDate, PlanDate) " & _
"SELECT DISTINCTROW tbl_Client.ClientSurname, tbl_Client.ClientFirstname,
tbl_Client.ClientNINumber, Tbl_Projects.StartDate,
Tbl_CurrentEmployers.CEHours, Tbl_Projects.EndDate,
Tbl_CurrentEmployers.ReasonForLeaving, Tbl_CurrentEmployers.ProgressionDate,
Tbl_CurrentEmployers.SustainedProgressionDate, Tbl_DevPlan.PlanDate " & _
"FROM ((Tbl_Projects INNER JOIN tbl_Client ON Tbl_Projects.ClientID =
tbl_Client.ClientID) LEFT JOIN Tbl_CurrentEmployers ON tbl_Client.ClientID =
Tbl_CurrentEmployers.ClientID) LEFT JOIN Tbl_DevPlan ON tbl_Client.ClientID =
Tbl_DevPlan.ClientID " & _
"WHERE (((Tbl_Projects.ProjectRef)='" & ProjectID & "'));")
DoCmd.SetWarnings True

Set rsClaimBreakDown = CurrentDb.OpenRecordset("TempTbl_WorkstepClaimData")

With rsClaimBreakDown
.MoveLast
NoOfRecords = rsClaimBreakDown.RecordCount
.MoveFirst
End With


'================================================= =====
'Insert the data from the temptable to the excel sheet
'================================================= =====

Dim CellRef As Integer
Dim NoOfLoops As Integer

openexcel (WhereTo) 'Gets the location of the template
xl.UserControl = False 'Doesnt allow user any control whilst we run our update
xl.Worksheets(2).Select 'Selects the claim breakdown sheet

'This section inserts the correct number of rows into the body of the
spreadsheet
NoOfLoops = NoOfRecords - 1
Do Until NoOfLoops = 0
xl.Rows("16:16").Select
xl.Selection.Insert Shift:=xlDown
xl.Rows("15:15").Select
xl.Selection.Copy 'need to copy the forumlas too, so cant just insert new rows
xl.Rows("16:16").Select
xl.ActiveSheet.Paste
xl.Application.CutCopyMode = False 'takes the flashing cell thing away
NoOfLoops = NoOfLoops - 1
Loop

'Insert the dates
xl.Range("C8").Value = Forms![Frm_Workstep]!txtStartDate
xl.Range("B10").Value = Forms![Frm_Workstep]!txtWeeks
xl.Range("E8").Value = Forms![Frm_Workstep]!txtEndDate

'This Loop section inserts the Data
CellRef = 15 'Starts at 15 because that is the start of the area i want to
insert into
NoOfLoops = NoOfRecords
With rsClaimBreakDown
.MoveFirst
Do Until NoOfLoops = 0
xl.Range("A" & CellRef & "").Value = rsClaimBreakDown![ClientSurname]
xl.Range("B" & CellRef & "").Value = rsClaimBreakDown![ClientFirstName]
xl.Range("C" & CellRef & "").Value = rsClaimBreakDown![ClientNINumber]
xl.Range("E" & CellRef & "").Value = rsClaimBreakDown![StartDate]
xl.Range("F" & CellRef & "").Value = rsClaimBreakDown![CEHours]
xl.Range("H" & CellRef & "").Value = rsClaimBreakDown![EndDate]
xl.Range("I" & CellRef & "").Value = rsClaimBreakDown![ReasonForLeaving]
xl.Range("S" & CellRef & "").Value = rsClaimBreakDown![ProgressionDate]
xl.Range("T" & CellRef & "").Value =
rsClaimBreakDown![SustainedProgressionDate]
xl.Range("Q" & CellRef & "").Value = rsClaimBreakDown![PlanDate]
CellRef = CellRef + 1
NoOfLoops = NoOfLoops - 1
.MoveNext
Loop
End With

xl.UserControl = True 'Give control back to the user
rsClaimBreakDown.CLOSE

MsgBox "Export to Claim Form completed successfully!", vbOKOnly, "Export
Completed"
DoCmd.CLOSE A_FORM, "Frm_Workstep"
xl.Visible = True

LocalExit:
Set xl = Nothing
Set rsClaimBreakDown = Nothing
Exit Sub

LocalError:
MsgBox Err.Number & vbCr & vbCr & Err.Description
Resume LocalExit

End Sub
---------------------
Openexcel Function:

Option Compare Database
Option Explicit

Public xl As Object 'This is how you will refer to the object once it is open

Function openexcel(strLocation)

Set xl = CreateObject("Excel.Application")

xl.Visible = False 'Makes the spreasheet visible. False will let you open
'it behind the scenes

xl.Workbooks.Open strLocation
'xl.Workbooks.Add 'Will Create a new workbook
End Function
Click to expand...
Click to expand...
 
K

Klatuu

Here is the Link:

http://www.mvps.org/access/api/api0001.htm

I don't know enought about those 3 extra rows. Are they on the same
worksheet you are importing? Do you mean you need to take fields from those
3 rows and add them to each row that you import into Access?

Justin said:
thanks, can you tell me that link, i dont see it. also can you tell me how to
add that flag and one other thing
The excel sheet (the template one) has 3 extra rows, that has to be added to
all rows where the data is placed. How can i do that automatically

Klatuu said:
I see you already have an open dialog to select the file. Can you modify it
to save a file? If not, here is a link to a very useful Open/Save API that
will do that for you. Once you are ready to do the export, call with the
Save and the user can pick a place to put it and a name to save it under.
You can also set a flag to warn the user if they are trying to save over an
existing file of the same name.

Justin said:
I have this database where the data from a table is needed to be exported .
Now I someone gave me a code that will open an preexisting excel sheet and
place all the data there. I love this code but the only problem is that this
code just keeps adding data to that excel sheet. I need a way to have like a
save dialog box appear, so that user will be able to save the file, so the
next time they run this, it won't keep adding. Please help.
here is the code I got::

*****

Private Sub cmdExport_Click()
On Error GoTo LocalError

Dim WhereTo As String
Dim ProjectID As String
Dim rsClaimBreakDown As DAO.Recordset
Dim NoOfRecords As Integer
Dim NoOfWorksheets As Integer

If IsNull(Me.txtStartDate) Or IsNull(Me.txtEndDate) Then
MsgBox "Cannot continue, data missing from Start/End Date boxes. Please fill
out before continuing!", vbOKOnly, "Data Capture Error"
txtStartDate.SetFocus
Exit Sub
End If

WhereTo = GetExportDirectory_Excel 'Open the save to dialog box

If WhereTo = "NoFile" Then Exit Sub

ProjectID = "WS"

DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM TempTbl_WorkstepClaimData")
DoCmd.RunSQL ("INSERT INTO TempTbl_WorkstepClaimData ( ClientSurname,
ClientFirstname, ClientNINumber, StartDate, CEHours, EndDate,
ReasonForLeaving, ProgressionDate, SustainedProgressionDate, PlanDate) " & _
"SELECT DISTINCTROW tbl_Client.ClientSurname, tbl_Client.ClientFirstname,
tbl_Client.ClientNINumber, Tbl_Projects.StartDate,
Tbl_CurrentEmployers.CEHours, Tbl_Projects.EndDate,
Tbl_CurrentEmployers.ReasonForLeaving, Tbl_CurrentEmployers.ProgressionDate,
Tbl_CurrentEmployers.SustainedProgressionDate, Tbl_DevPlan.PlanDate " & _
"FROM ((Tbl_Projects INNER JOIN tbl_Client ON Tbl_Projects.ClientID =
tbl_Client.ClientID) LEFT JOIN Tbl_CurrentEmployers ON tbl_Client.ClientID =
Tbl_CurrentEmployers.ClientID) LEFT JOIN Tbl_DevPlan ON tbl_Client.ClientID =
Tbl_DevPlan.ClientID " & _
"WHERE (((Tbl_Projects.ProjectRef)='" & ProjectID & "'));")
DoCmd.SetWarnings True

Set rsClaimBreakDown = CurrentDb.OpenRecordset("TempTbl_WorkstepClaimData")

With rsClaimBreakDown
.MoveLast
NoOfRecords = rsClaimBreakDown.RecordCount
.MoveFirst
End With


'================================================= =====
'Insert the data from the temptable to the excel sheet
'================================================= =====

Dim CellRef As Integer
Dim NoOfLoops As Integer

openexcel (WhereTo) 'Gets the location of the template
xl.UserControl = False 'Doesnt allow user any control whilst we run our update
xl.Worksheets(2).Select 'Selects the claim breakdown sheet

'This section inserts the correct number of rows into the body of the
spreadsheet
NoOfLoops = NoOfRecords - 1
Do Until NoOfLoops = 0
xl.Rows("16:16").Select
xl.Selection.Insert Shift:=xlDown
xl.Rows("15:15").Select
xl.Selection.Copy 'need to copy the forumlas too, so cant just insert new rows
xl.Rows("16:16").Select
xl.ActiveSheet.Paste
xl.Application.CutCopyMode = False 'takes the flashing cell thing away
NoOfLoops = NoOfLoops - 1
Loop

'Insert the dates
xl.Range("C8").Value = Forms![Frm_Workstep]!txtStartDate
xl.Range("B10").Value = Forms![Frm_Workstep]!txtWeeks
xl.Range("E8").Value = Forms![Frm_Workstep]!txtEndDate

'This Loop section inserts the Data
CellRef = 15 'Starts at 15 because that is the start of the area i want to
insert into
NoOfLoops = NoOfRecords
With rsClaimBreakDown
.MoveFirst
Do Until NoOfLoops = 0
xl.Range("A" & CellRef & "").Value = rsClaimBreakDown![ClientSurname]
xl.Range("B" & CellRef & "").Value = rsClaimBreakDown![ClientFirstName]
xl.Range("C" & CellRef & "").Value = rsClaimBreakDown![ClientNINumber]
xl.Range("E" & CellRef & "").Value = rsClaimBreakDown![StartDate]
xl.Range("F" & CellRef & "").Value = rsClaimBreakDown![CEHours]
xl.Range("H" & CellRef & "").Value = rsClaimBreakDown![EndDate]
xl.Range("I" & CellRef & "").Value = rsClaimBreakDown![ReasonForLeaving]
xl.Range("S" & CellRef & "").Value = rsClaimBreakDown![ProgressionDate]
xl.Range("T" & CellRef & "").Value =
rsClaimBreakDown![SustainedProgressionDate]
xl.Range("Q" & CellRef & "").Value = rsClaimBreakDown![PlanDate]
CellRef = CellRef + 1
NoOfLoops = NoOfLoops - 1
.MoveNext
Loop
End With

xl.UserControl = True 'Give control back to the user
rsClaimBreakDown.CLOSE

MsgBox "Export to Claim Form completed successfully!", vbOKOnly, "Export
Completed"
DoCmd.CLOSE A_FORM, "Frm_Workstep"
xl.Visible = True

LocalExit:
Set xl = Nothing
Set rsClaimBreakDown = Nothing
Exit Sub

LocalError:
MsgBox Err.Number & vbCr & vbCr & Err.Description
Resume LocalExit

End Sub
---------------------
Openexcel Function:

Option Compare Database
Option Explicit

Public xl As Object 'This is how you will refer to the object once it is open

Function openexcel(strLocation)

Set xl = CreateObject("Excel.Application")

xl.Visible = False 'Makes the spreasheet visible. False will let you open
'it behind the scenes

xl.Workbooks.Open strLocation
'xl.Workbooks.Add 'Will Create a new workbook
End Function
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Saving Xport to Excel file 1

Top