Access 2002/Running Macro using VB/Transfer Spreadsheet/Range

[13badar]

Hello,
I am trying to run this TRANSFER SPREADSHEET macro, but I think my syntax is wrong in the end for the [blue]RANGE[/blue] option:

Path = txtPath.Value
DoCmd.TransferSpreadsheet acExport, , MSA_SA & " RENEWAL", "" & Path & "", True, [blue](B8:H50)[/blue]

 

[13badar]

I tried using Quotes instead: [blue]"B8:H50"[/blue]
It gives me the following error:
Run-time Error'3673':
This table contains cells that are outside the range of cells defined in this spreadsheet.

I really need to paste the Table on the 8th line down in the Excel Spreadsheet.
Also, my data is static. Thats Y i wanted to keep my Range open.
As in, just start at B8 and no ending Range restricting the data from being posted.

 

[PHV]

The VBA help for the Transfer Spreadsheet method clearly says that the Range argument should be left empty for export.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[13badar]

I want to start outputting Tables to Excel on the 3rd line i.e. A3. Is there no other way that I can do that??

The reason I'm doing this is because I am adding a TOTALS line in the begining in the Excel Template I'm saving the Access Tables into. The TOTALS line is in the begining (A250) because the Outputted tables ARE STATIC IN DATA SIZE and could get big or small. Having a fixed column in the begining is the only feasible solution to this.

TIA for all your help.

 

[PHV]

You may consider pulling the data from Excel instead of pushing from access.
Take a look at the QueryTables collection or the CopyFromRecordset method.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[13badar]

Here's what my whole code looks like:

Option Compare Database

Private Sub cmdExport_Click()
Dim ReportType As String
Dim Path As String
Dim BegDate As Date
Dim EndDate As Date
Dim SQL As String
Dim db As Database
Dim MSA_ARRAY
Dim MSA_SA
Dim ServiceArea As String
Dim xl As New Excel.Application
Dim xwb As Workbook
Dim xws As Worksheet
Dim i As Integer
Dim rs As Recordset
Dim TodaysDate As String

If IsNull(Me.cboReport) Or Me.cboReport = "" Then
MsgBox "Please Select the Report Type to generate", , ""
Exit Sub
End If
If IsNull(Me.cboBegMonth) Or Me.cboBegMonth = "" Then
MsgBox "Please Select the Begining Month", , ""
Exit Sub
End If
If IsNull(Me.cboBegYear) Or Me.cboBegYear = "" Then
MsgBox "Please Select the Begining Year", , ""
Exit Sub
End If
If IsNull(Me.cboEndMonth) Or Me.cboEndMonth = "" Then
MsgBox "Please Select the Ending Month", , ""
Exit Sub
End If
If IsNull(Me.cboEndYear) Or Me.cboEndYear = "" Then
MsgBox "Please Select the Ending Year", , ""
Exit Sub
End If
BegDate = DateSerial(Me.cboBegYear, Me.cboBegMonth, 1)
EndDate = DateSerial(Me.cboEndYear, Me.cboEndMonth, 1)
If BegDate > EndDate Then
MsgBox "Beginning Date is later than the End Date", vbInformation, "DATE ERROR!"
Exit Sub
End If

ReportType = cboReport.Value
If ReportType = "Large Group" Then
MSA_ARRAY = Array("Capital SA", "Central SA", "East Bay SA", "Gldn Gate SA", "Inland EmpSA", _
"Metro LA SA", "NE Bay SA", "Orange SA", "Other", "San Diego SA", "South Bay SA", _
"Tri-CentrlSA", "Valleys SA")
ElseIf ReportType = "Labor and Trust" Then
MSA_ARRAY = Array("Lab&Trst NCA", "Lab&Trst SCA")
Else
MSA_ARRAY = Array("FEDS NCR", "Major NCR", "Major SCR", "National NCR", "National SCR", _
"PERS SCR", "Top30 NCR", "Top30 SCR")
End If

For Each MSA_SA In MSA_ARRAY

SQL = "SELECT A.PID, A.CID, A.SetID, A.[purchaser name] As [PURCHASER NAME], "
'SQL = SQL & "A.anniversarymonth As [Anniversary Month], A.contractyear As [Contract Year], "
SQL = SQL & "DateSerial([contractyear],[anniversarymonth],1) AS [RENEWAL DATE],"
SQL = SQL & "A.[AM/SE] As [ACCOUNT MANAGER], A.underwriter As [UW], A.[rate version] As [RATE VERSION], "
SQL = SQL & "A.[ARK quote ID] As

, A.[total members] As [TOTAL MEMBERS], A.[Final PMPM], A.[Target PMPM], "
SQL = SQL & "([Target PMPM]-[Final PMPM])/[Target PMPM] As CHANGE, "
SQL = SQL & "([Final PMPM]-[Target PMPM])*[total members]*12 As VARIANCE, A.MappedAccountType As [Mapped SA]"
SQL = SQL & " FROM tblReportType AS B INNER JOIN tblRenewalDataExtract AS A"
SQL = SQL & " ON B.SA = A.MappedAccountType"
SQL = SQL & " WHERE B.Report='" & ReportType & "'"
SQL = SQL & " And A.Status<>""quoted"""
SQL = SQL & " And A.anniversarymonth>=" & cboBegMonth.Value
SQL = SQL & " And A.anniversarymonth<=" & cboEndMonth.Value
SQL = SQL & " And A.contractyear>=" & cboBegYear.Value
SQL = SQL & " And A.contractyear<=" & cboEndYear.Value
SQL = SQL & " And A.MappedAccountType='" & MSA_SA & "'"
SQL = SQL & " Order by A.PID;"

Set db = CurrentDb
db.CreateQueryDef MSA_SA & " RENEWAL", SQL

Path = txtPath.Value
xl.Application.ScreenUpdating = True
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open Path
Set xwb = xl.ActiveWorkbook
xwb.Sheets.Add
Set xws = xl.ActiveSheet
xws.Name = MSA_SA & " RENEWAL"

TodaysDate = txtDate.Value
xws.Cells(2, 14) = "DATE: " & TodaysDate
xws.Cells(2, 2) = "SERVICE AREA: " & MSA_SA
xws.Cells(3, 2) = Month(BegDate) & "/" & Year(BegDate) & " - " & Month(EndDate) & "/" & Year(EndDate)
xws.Cells(4, 2) = ReportType & " Report"

ServiceArea = MSA_SA & " RENEWAL"
Set rs = db.OpenRecordset(ServiceArea)
With rs
i = 8
Do While Not .EOF
xws.Cells(i, 2) = rs("PID")
xws.Cells(i, 3) = rs("CID")
xws.Cells(i, 4) = rs("SetID")
xws.Cells(i, 5) = rs("PURCHASER NAME")
xws.Cells(i, 6) = rs("RENEWAL DATE")
xws.Cells(i, 7) = rs("ACCOUNT MANAGER")
xws.Cells(i, 8) = rs("UW")
xws.Cells(i, 9) = rs("RATE VERSION")
xws.Cells(i, 10) = rs("QUOTE ID")
xws.Cells(i, 11) = rs("TOTAL MEMBERS")
xws.Cells(i, 12) = rs("Final PMPM")
xws.Cells(i, 13) = rs("Target PMPM")
xws.Cells(i, 14) = rs("CHANGE")
xws.Cells(i, 15) = rs("VARIANCE")
i = i + 1
.MoveNext
Loop
End With
rs.Close

Next

DoCmd.DeleteObject acQuery, MSA_SA & " RENEWAL"

xl.ActiveWindow.Zoom = 75

xwb.saveas Path
xwb.Saved = True
xwb.Close
xl.Quit
MsgBox "U have saved the " & ReportType & " Report as " & Path, vbInformation

End Sub

 

[13badar]

I get the following error when I run the code above:

Run-time error '13':
Type Mismatch.

The highlighted line:

Set rs = db.OpenRecordset(ServiceArea)

 

[PHV]

Replace this:
Dim rs As Recordset
By this:
Dim rs As DAO.Recordset

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[13badar]

Hi PHV, I was checking everything if it works. It does with the new rs declaration.

I am getting the subscript out of range error for this line:
Run-time error '9': Subscript out of range
highlighted line: Set xws = xwb.Sheets(ServiceArea)

I already created an Excel file 'PATH' with titles for its sheets. The sheets names are MSA_SA & " RENEWAL" for all the MSA_SA's.
Now, as I save one MSA_SA data, I want to move on to the next MSA_SA after NEXT.
For that I have to set xws as the exact same MSA_SA & " RENEWAL", so thats why Im using the above line. I'm setting xws as the new MSA_SA value as MSA_SA's value changes after NEXT.

My code Below:

Option Compare Database

Private Sub cmdExport_Click()

Dim ReportType As String
Dim path As String
Dim BegDate As Date
Dim EndDate As Date
Dim SQL As String
Dim db As Database
Dim MSA_ARRAY
Dim MSA_SA
Dim ServiceArea As String
Dim xl As New Excel.Application
Dim xwb As Workbook
Dim xws As Worksheet
Dim i, j, k, l As Integer
Dim rs As DAO.Recordset
Dim TodaysDate As String

If IsNull(Me.cboReport) Or Me.cboReport = "" Then
MsgBox "Please Select the Report Type to generate", , ""
Exit Sub
End If
If IsNull(Me.cboBegMonth) Or Me.cboBegMonth = "" Then
MsgBox "Please Select the Begining Month", , ""
Exit Sub
End If
If IsNull(Me.cboBegYear) Or Me.cboBegYear = "" Then
MsgBox "Please Select the Begining Year", , ""
Exit Sub
End If
If IsNull(Me.cboEndMonth) Or Me.cboEndMonth = "" Then
MsgBox "Please Select the Ending Month", , ""
Exit Sub
End If
If IsNull(Me.cboEndYear) Or Me.cboEndYear = "" Then
MsgBox "Please Select the Ending Year", , ""
Exit Sub
End If
BegDate = DateSerial(Me.cboBegYear, Me.cboBegMonth, 1)
EndDate = DateSerial(Me.cboEndYear, Me.cboEndMonth, 1)
If BegDate > EndDate Then
MsgBox "Beginning Date is later than the End Date", vbInformation, "DATE ERROR!"
Exit Sub
End If

DoCmd.SetWarnings False
DoCmd.OpenQuery "qrytblForecastDataNew"
DoCmd.SetWarnings True

path = txtPath.Value
xl.Application.ScreenUpdating = True
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open path
Set xwb = xl.ActiveWorkbook
'Set xws = xl.ActiveSheet

ReportType = cboReport.Value
If ReportType = "Large Group" Then
MSA_ARRAY = Array("Capital SA", "Central SA", "East Bay SA", "Gldn Gate SA", "Inland EmpSA", _
"Metro LA SA", "NE Bay SA", "Orange SA", "Other", "San Diego SA", "South Bay SA", _
"Tri-CentrlSA", "Valleys SA")
ElseIf ReportType = "Labor and Trust" Then
MSA_ARRAY = Array("Lab&Trst NCA", "Lab&Trst SCA")
Else
MSA_ARRAY = Array("FEDS NCR", "Major NCR", "Major SCR", "National NCR", "National SCR", _
"PERS SCR", "Top30 NCR", "Top30 SCR")
End If

For Each MSA_SA In MSA_ARRAY

'RENEWAL QUERY
SQL = "SELECT A.PID, A.CID, A.SetID, A.[purchaser name] As [PURCHASER NAME], "
'SQL = SQL & "A.anniversarymonth As [Anniversary Month], A.contractyear As [Contract Year], "
SQL = SQL & "DateSerial([contractyear],[anniversarymonth],1) AS [RENEWAL DATE],"
SQL = SQL & "A.[AM/SE] As [ACCOUNT MANAGER], A.underwriter As [UW], A.[rate version] As [RATE VERSION], "
SQL = SQL & "A.[ARK quote ID] As

, A.[total members] As [TOTAL MEMBERS], A.[Final PMPM], A.[Target PMPM], "
SQL = SQL & "([Target PMPM]-[Final PMPM])/[Target PMPM] As CHANGE, "
SQL = SQL & "([Final PMPM]-[Target PMPM])*[total members]*12 As VARIANCE, A.MappedAccountType As [Mapped SA]"
SQL = SQL & " FROM tblReportType AS B INNER JOIN tblRenewalDataExtract AS A"
SQL = SQL & " ON B.SA = A.MappedAccountType"
SQL = SQL & " WHERE B.Report='" & ReportType & "'"
SQL = SQL & " And A.Status<>""quoted"""
SQL = SQL & " And A.anniversarymonth>=" & cboBegMonth.Value
SQL = SQL & " And A.anniversarymonth<=" & cboEndMonth.Value
SQL = SQL & " And A.contractyear>=" & cboBegYear.Value
SQL = SQL & " And A.contractyear<=" & cboEndYear.Value
SQL = SQL & " And A.MappedAccountType='" & MSA_SA & "'"
SQL = SQL & " Order by A.PID;"

Set db = CurrentDb
db.CreateQueryDef MSA_SA & " RENEWAL", SQL

ServiceArea = MSA_SA & " RENEWAL"
Set xws = xwb.Sheets(ServiceArea)
'Set xws = xl.ActiveSheet

TodaysDate = txtDate.Value
xws.Cells(1, 18) = TodaysDate
xws.Cells(1, 14) = "SERVICE AREA: " & MSA_SA
xws.Cells(1, 11) = Month(BegDate) & "/" & Year(BegDate) & " - " & Month(EndDate) & "/" & Year(EndDate)
xws.Cells(1, 7) = ReportType & " Report"

Set rs = db.OpenRecordset(ServiceArea)
With rs
i = 9
Do While Not .EOF
xws.Cells(i, 2) = rs("PID")
xws.Cells(i, 3) = rs("CID")
xws.Cells(i, 4) = rs("SetID")
xws.Cells(i, 5) = rs("PURCHASER NAME")
xws.Cells(i, 6) = rs("RENEWAL DATE")
xws.Cells(i, 7) = rs("ACCOUNT MANAGER")
xws.Cells(i, 8) = rs("UW")
xws.Cells(i, 9) = rs("RATE VERSION")
xws.Cells(i, 10) = rs("QUOTE ID")
xws.Cells(i, 11) = rs("TOTAL MEMBERS")
xws.Cells(i, 12) = rs("Final PMPM")
xws.Cells(i, 13) = rs("Target PMPM")
xws.Cells(i, 14) = rs("CHANGE")
xws.Cells(i, 15) = rs("VARIANCE")
i = i + 1
.MoveNext
Loop
End With
rs.Close

DoCmd.DeleteObject acQuery, MSA_SA & " RENEWAL"

Next

xwb.saveas path
xwb.Saved = True
xwb.Close
xl.Quit
MsgBox "U have saved the " & ReportType & " Report as " & path, vbInformation

 

[PHV]

Seems that your txtPath workbook don't have a sheet named MSA_SA & " RENEWAL"

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[13badar]

Well, The first Service Area in the MSA_SA list was "Capital SA"
so, the first worksheet was named "Capital SA RENEWAL".
Then MSA_SA took on the 2nd value as the MSA_SA "Central SA" so, the worksheet would be "MSA_SA RENEWAL" or "Central SA RENEWAL"

So, I really dont know what the problem is OR how to fix it.

p.s. All the Sheets in my template "PATH" file are in the same order as the service areas are laid out in MSA_ARRAY. Maybe I can use a command where xws goes to the next sheet on the RHS and puts in the data in the that one. So, instead of setting xws as "MSA_SA RENEWAL", can I set xws as "the next sheet" ???

 

[crobg]

PHV is right, "Capital SA RENEWAL" does not exsist in the file the you opened with txtPath.value. Put a stop at the line where you are bombing out and check the value of the ServiceArea variable.

In my testing your code in Office 2003 the Excel file was left open after the error. I had to close Excel process and open the file, repair and save it to use it again. You might want to check that as well.

 

[13badar]

Thank you guys for your helpful hints. I am going to rerun the whole thing and see where the value of the service area is changing. As far as the Excel file being left open, I think If I use On Error Resume Next it'll eliminate the problem since it'll goto the line where It says:
xwb.Close
xl.Quit