Creating Excel Sheet from Access but sheet is deleted when done

[DougP]

Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.Application.Visible = True
Dim Conn2 As ADODB.Connection
Dim Rs1 As ADODB.Recordset
Dim SQLCode As String
Set Conn2 = CurrentProject.Connection
Set Rs1 = New ADODB.Recordset

SQLCode = "SELECT [ChainOfCustody Details].[Project Number], [ChainOfCustody Details].Service, [ChainOfCustody Details].Number, " & _
"[ChainOfCustody Details].[Building Name], [ChainOfCustody Details].[HSA#],[ChainOfCustody Details].SampleNum, [NVLAP Details].Layer, " & _
"IIf([NVLAP Details].[Asbestos Type]='No Asbestos Detected','N','Y') AS [Abestos Y/N], " & _
"IIf([NVLAP Details].[Asbestos Type]='Y',7,8) AS [Response Priority], " & _
"IIf([NVLAP Details].[Asbestos Type]='No Asbestos Detected','NAD', " & _
"[NVLAP Details]![Asbestos Type]) AS [Asb Content], [NVLAP Details].[Asbestos Type], [ChainOfCustody Details].[Friable], [ChainOfCustody Details].[Condition]," & _
"[ChainOfCustody Details].[MaterialDescription], [ChainOfCustody Details].[HomogeneousAreaLocation], [ChainOfCustody Details].[SampleLocation], " & _
"[ChainOfCustody Details].[Quantity], [ChainOfCustody Details].[Units], [ChainOfCustody Details].[Photo] " & _
"FROM [NVLAP Details] INNER JOIN [ChainOfCustody Details] ON [NVLAP Details].SampleNum = [ChainOfCustody Details].SampleNum " & _
"Where [ChainOfCustody Details].[Project Number] = '" & Me.Project_Number & "'" & _
" And [ChainOfCustody Details].[Service] ='" & Me.Service & "' And [ChainOfCustody Details].[Number] = '" & Me.[Number] & "' " & _
" And [ChainOfCustody Details].[Building Name] = '" & Me.[Building Name] & "';"

Rs1.Open SQLCode, Conn2, adOpenStatic, adLockOptimistic

For a = 1 To Rs1.RecordCount
'ExcelSheet.Application.Cells(a + 6, 1).Value = Rs1![Project Number]
'ExcelSheet.Application.Cells(a + 6, 1).Value = Rs1![Service]
'ExcelSheet.Application.Cells(a + 6, 1).Value = Rs1![Number]
ExcelSheet.Application.Cells(a + 6, 1).Value = Rs1![Building Name]
ExcelSheet.Application.Cells(a + 6, 2).Value = Rs1![HSA#]
ExcelSheet.Application.Cells(a + 6, 3).Value = Rs1![SampleNum]
ExcelSheet.Application.Cells(a + 6, 4).Value = Rs1![MaterialDescription]
ExcelSheet.Application.Cells(a + 6, 5).Value = Rs1![HomogeneousAreaLocation]
ExcelSheet.Application.Cells(a + 6, 6).Value = Rs1![SampleLocation]
ExcelSheet.Application.Cells(a + 6, 7).Value = Rs1![Quantity] & Rs1![Units]
ExcelSheet.Application.Cells(a + 6, 8).Value = Rs1![Asb Content]
ExcelSheet.Application.Cells(a + 6, 9).Value = Rs1![Response Priority]
ExcelSheet.Application.Cells(a + 6, 10).Value = Rs1![Asb Content]
ExcelSheet.Application.Cells(a + 6, 11).Value = Rs1![Friable]
ExcelSheet.Application.Cells(a + 6, 12).Value = Rs1![Condition]
ExcelSheet.Application.Cells(a + 6, 13).Value = Rs1![Photo]

Rs1.MoveNext
Next
' Set ExcelSheet = Nothing < this is REMed out
' close it this way
Set Rs1 = Nothing
Set Conn2 = Nothing

DougP

 

[xlbo]

I have replied in the MSOffice forum as well but should post here also

I think the reason that your "sheet" disappears is that it is only a sheet. Excel requires a WORKBOOK container to hold a sheet.

you therefore need to create an excel WORKBOOK which will have a sheet created automatically within it - you then reference the sheet within the workbook to put your data on it and finally save the workbook itself rather than the sheet. AFAIK, sheets cannot exist without workbooks

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[DougP]

yes here is my code

    Dim objXL As New Excel.Application
    Dim objXLBook As Excel.Workbook
    Dim objXLSheet As Excel.Worksheet

    objXL.Application.Visible = True
    Set objXLBook = objXL.Workbooks.Add
    Set objXLSheet = objXLBook.Worksheets("Sheet1")

    With objXLSheet
        
            objXLSheet.Cells(1, 1).Value = something
            
    End With

DougP

 

[xlbo]

Please clarify - that is code which goes with what you posted initially or that is new code ?

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[DougP]

Sorry this is new code that fixed the problem.
The top 3 lines of my original code were replaced by the top 6 lines of the new code

Actually I had to add the "With-EndWith around the for next loop

    With objXLSheet
        For a = 1 To Rs1.RecordCount
            objXLSheet.Cells(a + 7, 1).Value = Rs1![Building Name]
       	....
            Rs1.MoveNext
        Next
    End With

Hope this helps


DougP

 

[JerryKlmns]

DougP

There is also the .CopyFromRecordset method of the excel's Range object, to do what it says. Help 's example, shows also how to get fields name to columns. Maybe faster than the loop and one line only.
Also be aware that the For Next loop, checks the .Recordcount property of the recordset on every loop. It would more efficient to store that in a variable and check only once.