Opening Excel sheet from Access

[JulieS]

Hello,

I'm importing data from Excel (using the DoCmd.TransferSpreadsheet in VBA). The problem is if the excel sheet to be imported is not currently open (the error message says the external table isn't in the expected format).

Is there a way to check if the table is open and if not, open from x location?

Thanks!

Julie

 

[Shamous]

I will assume that you don't want to just manualy import the data into Access. I will also assume you have both Access97 and Excel97, but its the same for 2000.

I never like the docmd.TransferSpreedSheet method. I use code to open and instance of Excel.....find the proper cells and the suck the data into a predesigned table for use
see example: Clip this out and paste it to a large notepad.
email me if you need more help. You can ignore most of the debug.prints and other code. just look and the cell enumeration

Private Sub Command16_Click()
'written by Rusty Fenn
Dim objxl As New Excel.Application
Dim objwb As Workbook
Dim db As Database
Dim rst As Recordset
Dim rstA As Recordset
Dim CurrentSheet As Variant
Dim i, j As Integer
Dim intRecordCounter As Integer
Dim strDate As Date
Dim MaxDate As Date
Dim strTempNum As String
Dim strTemp As String
Dim strTestChar As String
Dim savemessage As String

On Error GoTo Cleanup

Me.Command16.Tag = Me.Command16.Caption

If IsNull(Me.Text20) Then
Msgbox ("You must either type in a path and filename or use the control to the right&quot
DoCmd.GoToControl ("text20&quot
Exit Sub
End If
'set objects
Set objwb = objxl.Workbooks.Open(Me.Text20)
Set db = CurrentDb()

Set rst = db.OpenRecordset("SELECT MAX([RejectDate]) As MaxRejectDate From Reject&quot
MaxDate = rst!maxrejectdate
rst.Close

Set rst = db.OpenRecordset("reject&quot

'set starting Ints
i = 1
j = 3
intRecordCounter = 0

DoCmd.Hourglass True

With objwb 'workbook object
For Each CurrentSheet In .Sheets
strDate = .Sheets(i).Range("A1&quot.Value
If Not IsNull(strDate) And strDate > MaxDate Then
'*************************** Shove Section *************************
'* *
'* Shove the rejects into CF/reject table *
'* *
'********************************************************************

Do Until .Sheets(i).Cells(j, 1) = "Total Items"
If Trim(CStr(.Sheets(i).Cells(j, 2).Value)) <> &quot;&quot; And Not IsNull(Trim(CStr(.Sheets(i).Cells(j, 2).Value))) Then
rst.AddNew
rst.Fields(1) = Trim(CStr(.Sheets(i).Cells(j, 2).Value)) 'Identifier
Debug.Print Trim(CStr(.Sheets(i).Cells(j, 2).Value))
rst.Fields(6) = Trim(CStr(.Sheets(i).Cells(j, 3).Value)) 'Label
Debug.Print Trim(CStr(.Sheets(i).Cells(j, 3).Value))
rst.Fields(3) = Trim(CCur(.Sheets(i).Cells(j, 4).Value)) 'Amount
Debug.Print Trim(CCur(.Sheets(i).Cells(j, 4).Value))
rst.Fields(2) = .Sheets(i).Cells(j, 5).Value 'code
Debug.Print .Sheets(i).Cells(j, 5).Value
rst.Fields(7) = .Sheets(i).Cells(j, 6).Value 'Corrected data
Debug.Print .Sheets(i).Cells(j, 6).Value
rst.Fields(4) = strDate 'RejectDate
Debug.Print strDate
Debug.Print &quot;_____________________&quot;
rst.Update
rst.Bookmark = rst.LastModified


If Len(Trim(CStr(.Sheets(i).Cells(j, 2).Value))) = 14 Then
strTempNum = Right(Trim(CStr(.Sheets(i).Cells(j, 2).Value)), 10)
ElseIf Len(Trim(CStr(.Sheets(i).Cells(j, 2).Value))) = 10 Then
strTempNum = Trim(CStr(.Sheets(i).Cells(j, 2).Value))
End If
strTestChar = &quot;[&quot; & CurrentSheet.NAME & &quot;] &quot; & Len(Trim(CStr(.Sheets(i).Cells(j, 2).Value))) & _
&quot; &quot; & strTempNum & &quot; &quot; & .Sheets(i).Cells(j, 5).Value

savemessage = vbCrLf & Me.Text18.Value


'*************************** Shove Section *************************
'* *
'* Update the rejects into CF/reject table *
'* *
'********************************************************************
If rst.Fields(2) Like &quot;[!c]*&quot; Then

Set rstA = db.OpenRecordset(&quot;SELECT SuspendBilling, SuspendDate, RebillAmt, RebillDate, Rebill, x_doc_No &quot; & _
&quot;FROM CF1 WHERE X_Doc_No = '&quot; & strTempNum & &quot;'&quot
With rstA
If Not .BOF Then
.Edit
If rst.Fields(2) <> &quot;R01&quot; And rst.Fields(2) <> &quot;R09&quot; Then
!SuspendBilling = True
'!SuspendDate = strDate
Me.Text18 = strTestChar & &quot; Updated&quot; & savemessage
Else
If Not IsNull(!RebillAmt) Then
!RebillAmt = !RebillAmt + rst.Fields(3) + 25
Else
!RebillAmt = rst.Fields(3) + 25
End If
!RebillDate = Date
!Rebill = True
Me.Text18 = strTestChar & &quot; Rebilled - &quot; & CCur(rst.Fields(3) + 25) & savemessage
End If
.Update
.Bookmark = .LastModified
.Close
Else
strTemp = Msgbox(&quot;There is an error: there was no record.&quot
.Close
End If
End With
Set rstA = Nothing
Else
Me.Text18 = strTestChar & &quot; &quot; & savemessage
End If
rst.Bookmark = rst.LastModified
j = j + 1 'increment column
intRecordCounter = intRecordCounter + 1
Me.Command16.Caption = intRecordCounter
Me.Repaint
'DoCmd.Echo True, intRecordCounter
Else
Debug.Print &quot;Missing Referrence number - Skipped&quot;
End If
Loop
Else
Debug.Print &quot;Skipped &quot; & CurrentSheet.NAME
End If
i = i + 1 'increment Sheets
j = 3
Next CurrentSheet
End With



Cleanup: 'clean up
DoCmd.Hourglass False
Me.Command16.Caption = Me.Command16.Tag
rst.Close
Set objwb = Nothing
Set objxl = Nothing
Set rst = Nothing
Set db = Nothing
'Msgbox (strDate & vbTab & MaxDate & vbCrLf & &quot;You already have these rejects&quot; & vbCrLf & &quot;or they are null&quot

End Sub