Ok this is a new one I've not seen anywhere and I'm wondering if any of you guys can offer some advice on what on earth is going on here.
Basically this process rips a load of data from a query and dumps it into a new sheet in a workbook.
and there in lies the problem, in order to get it to put things in tabs properly I've had to build strSheetName expression but when translated to a tab name instead of
I get
hence the bit under the transferspreadsheet that removes this
that all being well and good is quite slow and falls over if the strSheetName ends up containing brackets any ideas how to get this to work properly
Basically this process rips a load of data from a query and dumps it into a new sheet in a workbook.
and there in lies the problem, in order to get it to put things in tabs properly I've had to build strSheetName expression but when translated to a tab name instead of
Code:
Something
Code:
"Something_
that all being well and good is quite slow and falls over if the strSheetName ends up containing brackets any ideas how to get this to work properly
Code:
Private Sub cmdOSP_Click()
On Error GoTo Err_cmdOSP_Click
'GoTo Exit_cmdOSP_Click
Dim rs As Recordset
Dim db As DAO.Database
Dim varList As String
Dim strSQL As String
Dim qdf As DAO.QueryDef
Dim strClassName As String
Dim strSheetName As String
Dim strSheetName1 As String
Set db = CurrentDb()
Set rs = db.OpenRecordset("Select Class From tblClass")
Set qdf = db.QueryDefs("qryOSP")
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryOSP", CurrentProject.Path & "\Output\OSP_Analysis.xls", True, "OSP Analysis"
Set qdf = Nothing
Do Until rs.EOF
strClassName = ""
strClassName = "'" & rs!Class & "'"
strSQL = "SELECT [tblMEList].[Equipment Tag], [tblPlatformList].Vessel, tblClass.Class, [tblShipFitData].[Quantity fitted]" & _
"FROM ([tblMEList] INNER JOIN [tblShipFitData] ON [tblMEList].[Equipment Tag] = [tblShipFitData].Equipment)INNER JOIN (tblClass INNER JOIN [tblPlatformList] ON tblClass.Class = [tblPlatformList].Class) ON [tblShipFitData].Vessel = [tblPlatformList].Vessel "
strSQL = strSQL & "WHERE tblClass.Class IN (" & strClassName & ");"
Set qdf = db.QueryDefs("qryClassOutput")
qdf.SQL = strSQL
strSheetName = ""
strSheetName = Chr(34) & rs!Class & Chr(34)
strSheetName1 = rs!Class
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryClassOutput", CurrentProject.Path & "\Output\OSP_Analysis.xls", True, strSheetName
Debug.Print rs!Class
Debug.Print strSheetName
Set qdf = Nothing
rs.MoveNext
Dim XLApp As Object
' Open the XLS fle
Set XLApp = CreateObject("Excel.Application")
With XLApp
'Keep working in the background for now
.Application.Visible = False
.UserControl = True
'Open Workbook
.Workbooks.Open CurrentProject.Path & "\Output\OSP_Analysis.xls"
'Remove excess Charcters
.Sheets(Chr(34) & strSheetName1 & "_").Name = strSheetName1
.Application.DisplayAlerts = False
.ActiveWorkbook.SaveAs CurrentProject.Path & "\Output\OSP_Analysis.xls"
.Workbooks.Close
.Quit
.Application.Visible = True
.Application.DisplayAlerts = True
End With
Set XLApp = Nothing
Loop
Set db = Nothing
Exit_cmdOSP_Click:
MsgBox "This Feature is not enabled yet", vbOKOnly, "Error"
Exit Sub
Err_cmdOSP_Click:
MsgBox Err.Number & " " & Err.Description
Resume Exit_cmdOSP_Click
End Sub