Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

runtime error 1004 Too many different cell formats

Status
Not open for further replies.
vba317

vba317

Programmer
Mar 5, 2009
708
US
I am using excel 2003. I am getting a runtime error 1004 Too many different cell formats . When I look at the code goXL.Workbooks(strNewWkbk) I get the message the remote server machine does not exist. The other parts of the line of code look valid. Any help is appreciated Tom



Code: 
Public Sub cmdRunPrintSets_Click()

Dim strSQL As String
Dim rstPQ As DAO.Recordset
Dim rstRpts As DAO.Recordset
Dim iQ As Double
Dim iRpt As Double
Dim strPathName As String
Dim strSrcPath As String
Dim strSaveName As String
Dim strNewWkbk As String
Dim iPageCnt As Double
Dim iRw As Double
Dim strMenuItm As String
Dim iPgBrkCnt As Double
Dim strStartTime As String
Dim strEndTime As String
Dim intClientID As Double
Dim strClientName As String
'Dim tabnm()

DoCmd.SetWarnings False

' Create Excel Instance
Call XLCreate ' New Excel Instance - goXL
If gbXLPresent = True Then ' If Excel installed
    ' *** Get Print Queues to Process
    Set rstPQ = CurrentDb.OpenRecordset("PROC_PrntQ_Detail", dbOpenTable)
    If Not rstPQ.EOF Then
        With rstPQ
            .MoveLast
            .MoveFirst
        End With
        For iQ = 1 To rstPQ.RecordCount
            ' Set Package Save Name
            strSrcPath = "\\salmfilesvr1\Public\Client Services\AutoRpts\_Rpts\" & (GetCompany(rstPQ![clntid])) & "\" & (rstPQ![UCI]) & "\"
            strPathName = "\\salmfilesvr1\Public\Client Services\AutoRpts\_RptSets\" & (GetCompany(rstPQ![clntid])) & "\" & (rstPQ![UCI]) & "\" & (GetMonthPath(rstPQ![prptpd]))
            strSaveName = (rstPQ![deltypedsc]) & "_" & (rstPQ![UCI]) & "_" & (rstPQ![mon_shnm]) & "_" & (rstPQ![yr]) & "_" & (FixDesc(rstPQ![deltoname])) & "_" & (rstPQ![prntqid]) & ".xls"
            'Set Time stamp for when reports start
            strSQL = "UPDATE tblTime SET PrtSetStart =Now(),PrtSetStartTime=Time()" & _
            " WHERE PrtSetStart Is Null and ClientName='" & (rstPQ![UCI]) & "'"
              CurrentDb.Execute strSQL
            ' Get reports for this queue
            With DoCmd
                .OpenQuery "000_ClearTableOfContents"
            End With
            strSQL = "INSERT INTO PROC_TableOfContents (ord,rpttitle,rptsubtitle,tabnm,fname ) " & _
                        "SELECT pr.ord,rq.rpttitle,rq.rptsubtitle,rq.tabnm,rq.rptname " & _
                        "FROM dbo_prntq_rpts pr " & _
                            "INNER JOIN dbo_Rpts_RptsQueued rq ON pr.rptqid = rq.qrptid " & _
                        "WHERE ((pr.prntqid=" & (rstPQ![prntqid]) & ") AND (rq.qrptpd = " & (rstPQ![prptpd]) & ")) " & _
                        "ORDER BY pr.ord;"
            CurrentDb.Execute strSQL
            ' Build Report Package
            ' Open Cover Template
            goXL.Workbooks.Open Filename:="\\salmfilesvr1\Public\Client Services\AutoRpts\Templates\Cover.xlt"
            strNewWkbk = goXL.ActiveWorkbook.Name
            With goXL.Sheets("Cover")
                .Cells(8, 1).Value = GetClntName(rstPQ![clntid])
                .Cells(10, 1).Value = (rstPQ![prnttitle])
                .Cells(11, 1).Value = (rstPQ![prntsubtitle])
                .Cells(13, 1).Value = "'" & (GetFullMonthName(rstPQ![prptpd]))
                .Name = (rstPQ![UCI])
            End With
            ' Add Table of Contents
            With goXL
                .Workbooks.Open Filename:="\\salmfilesvr1\Public\Client Services\AutoRpts\Templates\TableOfContents.xlt"
                .Sheets("Table of Contents").Copy After:=Workbooks(strNewWkbk).Worksheets(1)
                .Workbooks(2).Close SaveChanges:=False
            End With
            ' Get list of reports for this print set
            strSQL = "SELECT ord,tabnm,fname FROM PROC_TableOfContents ORDER BY ord;"
            Set rstRpts = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
            If Not rstRpts.EOF Then
                With rstRpts
                    .MoveLast
                    .MoveFirst
                End With
                For iRpt = 1 To rstRpts.RecordCount ' Cycle through reports
                    goXL.Workbooks.Open Filename:=(strSrcPath) & (rstRpts![fname]) ' Open Report
                    ' *** Get number of pages and update list
                    ' Count Pages in Report
                    'orig code
                    'iPageCnt = ActiveSheet.HPageBreaks.Count + 1
                    iPageCnt = goXL.ActiveSheet.HPageBreaks.Count + 1 ' added 3/20/2013
                    ' Update with Pages
                    strSQL = "UPDATE PROC_TableOfContents SET pgs = " & (iPageCnt) & " WHERE ord = " & (rstRpts![ord]) & ";"
                    CurrentDb.Execute strSQL
                    ' Copy to print set and close
                    With goXL
                        'orig code
                        '.Sheets("" & (rstRpts![tabnm]) & "").Copy After:=Workbooks(strNewWkbk).Worksheets((iRpt + 2)) 'added back in 4/04/2013 causing report order to be wrong
 [Yellow]                       .Sheets("" & (rstRpts![tabnm]) & "").Copy After:=goXL.Workbooks(strNewWkbk).Worksheets((iRpt + 2)) 'added 06/07/2014  [/Yellow]
                        'orig code
                       .Workbooks(2).Close SaveChanges:=False
                        '.ActiveWorkbook.Close SaveChanges:=False 'added 3/20/2013
                    End With
                    rstRpts.MoveNext
                Next iRpt
            End If
            rstRpts.Close
            Set rstRpts = Nothing
            ' Populate Table of Contents
            goXL.Sheets("Table of Contents").Select
            ' Add First 3 Sheets (Cover, Table of Contents, Glossary)
            With goXL.ActiveSheet
                .Cells(4, 1).Value = "Cover Page"
                .Cells(4, 15).Value = 1
                .Cells(5, 1).Value = "Table of Contents"
                .Cells(5, 15).Value = 2
                .Cells(5, 27).Value = 1
                .Cells(6, 1).Value = "Glossary"
                .Cells(6, 27).Value = 1
            End With
            ' Add Additional Sheets
            iRw = 7
            iPgBrkCnt = 1
            strSQL = "SELECT rpttitle,rptsubtitle,tabnm,pgs FROM PROC_TableOfContents ORDER BY ord;"
            Set rstRpts = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
            If Not rstRpts.EOF Then
                With rstRpts
                    .MoveLast
                    .MoveFirst
                End With
                For iRpt = 1 To rstRpts.RecordCount ' Cycle through reports
                    ' For Excel File Types include Tab Name
                    If ((rstPQ![deltypedsc] = "EMAIL") Or (rstPQ![deltypedsc] = "FTP") Or (rstPQ![deltypedsc] = "CDROM") Or (rstPQ![deltypedsc] = "INFOEDGE")) Then
                        strMenuItm = (rstRpts![rpttitle]) & " - " & (rstRpts![rptsubtitle]) & " (" & (rstRpts![tabnm]) & ")"
                    Else ' For Non File Types, no Tab Name
                        strMenuItm = (rstRpts![rpttitle]) & " - " & (rstRpts![rptsubtitle])
                    End If
                    With goXL.ActiveSheet
                        .Cells(iRw, 1).Value = strMenuItm
                        .Cells(iRw, 27).Value = (rstRpts![pgs])
                    End With
                    ' Advance to next report
                    iRw = iRw + 1
                    iPgBrkCnt = iPgBrkCnt + 1
                    If (iPgBrkCnt > 33) Then ' Insert Page Break every 79 lines
                        With goXL
                            .Rows("" & (iRw) & ":" & (iRw) & "").Select
                            .ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
                        End With
                        iPgBrkCnt = 1
                    End If
                    rstRpts.MoveNext
                Next iRpt
                ' Delete Extra Rows in Table of Contents
                With goXL
                    .Rows("" & (iRw) & ":250").Select
                    .Selection.Delete Shift:=xlUp
                    .Cells(4, 1).Select
                End With
                ' Set Page Count for Table of Contents
                iPageCnt = (ActiveSheet.HPageBreaks.Count) + 1
                ActiveSheet.Cells(5, 27).Value = (iPageCnt)
            End If
            rstRpts.Close
            Set rstRpts = Nothing
            'Verify folder exists added 4/8/2013
            Call PrntCreateFolders
           
             ' Save and Close Print Set
            With goXL
                .Sheets("Table of Contents").Cells(4, 1).Select
                .Sheets("" & (rstPQ![UCI]) & "").Select
                .DisplayAlerts = False
                .ActiveWorkbook.SaveAs Filename:=(strPathName) & (strSaveName)
                .Workbooks.Close
                .DisplayAlerts = True
            End With
            ' Flag Print Set as run and save file name
            strSQL = "UPDATE dbo_Rpts_PrntSetQueue " & _
                        "SET runflag = 1" & _
                            ",filenm = '" & (strSaveName) & "' " & _
                        "WHERE (prntqid = " & (rstPQ![prntqid]) & ");"
            CurrentDb.Execute strSQL
            ' Advance to next queue item
            'End Time Count
'           Added function to only update latest record 04/06/2013
        strSQL = "UPDATE tblTime SET PrtSetEnd=Now(),PrtSetEndTime=Time() " & _
         " WHERE ID=(SELECT Max(ID) FROM tblTime " & _
         " WHERE ClientName='" & rstPQ!UCI & "')"
            CurrentDb.Execute strSQL
            rstPQ.MoveNext
        Next iQ
         
    End If
    rstPQ.Close
    Set rstPQ = Nothing
    ' Kill Excel
    Call XLKill
    ' Clear Print Set List and refresh listbox
    With DoCmd
        .OpenQuery "000_ClearPrintQProc"
        .OpenQuery "000_ClearPrntQDetail"
    End With
    With Me.lstPrintSets
        .SetFocus
        .Requery
    End With
Else
    MsgBox "ERROR:  COULD NOT OPEN EXCEL.", , "BOO!!!"
End If

DoCmd.SetWarnings True

MsgBox "Print Sets Created!", , "All Done."

End Sub
 
Sort by date Sort by votes
Just to add more info. The sheet that is supposed to be created has been created with no problem. The workbook that workbook is supposed to go into is open.
 
Upvote 0 Downvote
Anyway, you still use unqualified excel objects, like here:
.Sheets("Table of Contents").Copy After:=[!]goXL.[/!]Workbooks(strNewWkbk).Worksheets(1)
or here:
.ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=[!]goXL.[/!]ActiveCell
or here:
iPageCnt = ([!]goXL.[/!]ActiveSheet.HPageBreaks.Count) + 1
[!]goXL.[/!]ActiveSheet.Cells(5, 27).Value = (iPageCnt)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
I made all the recommended changes. I also opened the file and removed all styles with the exception of normal
 
Upvote 0 Downvote
I am still getting the same error
 
Upvote 0 Downvote
How is you template workbook FORMATTED?

What kind of sheets? Tables, 'forms', miscellaneous formatting???

You're using 10+ year old technology, not that it should not work, but newer versions make more efficient use of formats, especially repeating tabular formats.



Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Upvote 0 Downvote
After looking into it more closely, I am starting to think that the manager put too many reports in the file (96) maybe this is causing the issue? The total amount of reports for the client is over 450. I had previously loaded the program from that article and it did say my file was corrupted but when I tried to apply the fix it didn't work. On Monday I am going to tell the manager to split up the reports and I am hoping that will fix the issue. Skip, as usual you are correct I am most likely getting this error because I am using excel 2003. Later this year my company is going to upgrade to SQL 2014 BI edition and Office 2013.
 
Upvote 0 Downvote
Well it might be the method of dispensing 96 reports.

Is that 96 different reports, the same report to 96 recipients or something between those two?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Upvote 0 Downvote
It is 96 different reports. But the same report can be done 8 different ways for example executive summary for all providers, another executive summary report by department and another executive summary report by location. 3 different reports using the same template. So even thou it is 96 different reports it is probably using 60 or so different templates.
 
Upvote 0 Downvote
So does one template close, report disposed of and closed, before another template/report is started?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Upvote 0 Downvote
Yes, The destination file stays open. Once the source template is populated than copied into the destination file it is closed and killed.
 
Upvote 0 Downvote
After I had the client manager split up the report packages so there was less than 50 tabs in each report every thing ran fine.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Helpful tip
Microsoft Office 365 Word Macro Causing a Project is unviewable error
Replies
1
Views
273
dhookom
dhookom
remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
544
remeng
remeng
morechocolate
  • Locked
  • Question
run-tune error 3704 operation is not allowed when the object is codes: I don't think so.
Replies
7
Views
561
morechocolate
morechocolate
huiettcm
  • Locked
  • Question
Catching the Mouse Click Error in Modal User Form
Replies
1
Views
194
strongm
strongm
sxschech
  • Locked
  • Question
For Each Loop works once then gives error 91 2
Replies
19
Views
338
sxschech
sxschech

Part and Inventory Search

Sponsor

Back
Top