Fejlmeddelelse ved hentning af data
Jeg har nedenstående makro i en Excel Addin-fil.Hver gang jeg åbner Excel får jeg denne fejlmeddelelse:
\"Menuopsætning blev ikke fundet. Kontakt regnskabsafdelingen.\"
Er der nogen der kan se hvor fejlen ligger?
Dim rsdata As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim objField As ADODB.Field
Dim lOffset As Long
Dim ReportPath As String
\' Hvis der opstår en fejl, kommer der en fejlmeddelelse og makroen afsluttes
On Error GoTo errhand
\' Hent stien til \"xlMenuTable.xls\" i nuværende Menutabel. _
Denne sti kan så udskiftes med \"Thisworkbook.Path\" nedenfor.
ReportPath = shMenuTable.Cells.Find(What:=\"ReportPath\").Offset(1).Value
\' tilføj en connection string.
szConnect = \"Provider=Microsoft.Jet.OLEDB.4.0;\" & _
\"Data Source=\" & ReportPath & \"\\Menuopsætning Salg.xlsx;\" & _
\"Extended Properties=Excel 8.0;\"
\' tilføj en SQL sætning.
szSQL = \"select * from [MenuTable$]\"
\' tilføj et datasæt (recordset) object og kører SQL forespørgslen.
Set rsdata = New ADODB.Recordset
rsdata.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
\' check om datasættet indeholder data.
If Not rsdata.EOF Then
shMenuTable.Cells.Delete
\' tilføj feltnavne til menutabelarket.
With shMenuTable.Range(\"A1\")
For Each objField In rsdata.Fields
.Offset(0, lOffset).Value = objField.Name
lOffset = lOffset + 1
Next objField
.Resize(1, rsdata.Fields.Count).Font.Bold = True
End With
\' indsæt datasættet i arket MenuTable.
shMenuTable.Range(\"A2\").CopyFromRecordset rsdata
Else
MsgBox \"Menuopsætningen er tom. Kontakt regnskabsafdelingen\", vbCritical
End If
\' Luk datasættet
rsdata.Close
Set rsdata = Nothing
Exit Sub
errhand:
MsgBox \"Menuopsætning blev ikke fundet. Kontakt regnskabsafdelingen.\", vbCritical
End Sub