3061 Error, Queries, and VBA

M

matt beamish

Registered User.
Local time
Today, 17:03
Joined
Sep 21, 2000
Messages
215
I am using a utility put up on line here :
http://www.peterssoftware.com/mlm.htm
to represent spatial data using Googlemaps from within an Access database.

I am using the mapping function with app. 2000 pieces of project data, that has OSGB coordinates, that are converted on the fly to lat lng. These are then mapped by the mapping function.
On an unfiltered/complete dataset, the mapping function runs fine.

As there is so much data, I want to filter it down, so that users are only presented with a mapping pin for the the current record and those that are within a range of it. So I have used an unbound control (Distancecntrl) on a form to hold a range variable which is used in a selection query to restrict the dataset.

Query definition is
Code: 
Between ([Forms]![F_LocationConversiontoLatlong]![East]-[Forms]![F_LocationConversiontoLatlong]![Distancecntrl]) And ([Forms]![F_LocationConversiontoLatlong]![East]+[Forms]![F_LocationConversiontoLatlong]![Distancecntrl])


The query that filters/restrict the dataset runs fine to show a subset of the records, but this query is effectively rejected by the mapping function.

The error message (Error in FMLMMMapit (3), object DAO.Database 3061 - Too few parameters. Expected 2.) points to this bit of VBA:

Code: 
Set rst = dbs.OpenRecordset("Select * from [" & pstrTableOrQueryName & "];", dbOpenForwardOnly)

From reading around, I can see that there are problems with accessing the values in Form controls when accessed from VBA. So I have instead tried setting TempVars for my variables, but that doesnt stop the problem. Have also tried using Qrydefs this evening (commented out in the code below), but I have not had success there either.

Can anyone help on this?

The complete function is here:
Code: 
Function fMLMMapIt( _
     pstrTableOrQueryName As String _
    , Optional pstrLatitudeFieldName As String = "lat" _
    , Optional pstrLongitudeFieldName As String = "lng" _
    , Optional pstrMapPointColorFieldName As String = "MapPointColor" _
    , Optional pstrMapPointLetterFieldName As String = "MapPointLetter" _
    , Optional pstrPopUpInfoFieldName As String = "PopUpInfo" _
    ) As Integer
'******************************************************************************
'* Peter De Baets, author
'* 5/23/2011
'* This routine updates empty latitude and longitude field values in an "Addresses"
'* table. It first removes any apartment number in the address string (see query
'* "qryAddressesNoApt"), then uses the Google Geocoding API to get the lat and lng
'* values, then updates all rows of the Addresses table that have the same address
'* minus the apartment number. This method makes the most efficient use of the
'* Google Geocoding API.
'*
'* A reference to DAO, and Microsoft XML, v6.0 is required for this routine to run
'******************************************************************************
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim loc As LatLng
Dim Knt As Integer
Dim strsql As String
Dim strLastError As String
Dim intErr As Integer
Dim Rtn As Integer
Dim strTempTableName As String
Dim dblLat As Double
Dim dblLng As Double
Dim strPhase As String
Dim strColor As String
Dim strLetter As String
Dim strPopUpInfo As String
Dim LLK(400) As LatLng
Dim LLKSub As Integer
Dim FoundIt As Integer
Dim i As Integer
Dim j As Integer
Dim Marker As Integer

'v1.3
Dim strLat As String
Dim strLng As String
Dim strDecimalPoint As String
Dim strTempQueryName As String
Dim qdf As DAO.QueryDef
Dim strFolder As String
Dim strOutputFileName As String
Dim strExistingTableName As String
Dim tdf As DAO.TableDef



On Error GoTo Err_Section
Marker = 1

If fIsConnectedToInternet Then
Else
    GoTo Exit_Section
End If

Marker = 2
Set dbs = CurrentDb()
Marker = 3
'DoCmd.Print pstrTableOrQueryName

'* v1.2
strDecimalPoint = Mid(CStr(3 / 2), 2, 1)


'mb added the following
'Set qdf = dbs.QueryDefs("Q_project_return_latlong")
 'qdf("Forms!F_LocationConversiontoLatlong!East") = Forms!F_locationconversiontolatlong!East
'qdf("Forms!F_locationconversiontolatlong!North") = Forms!F_locationconversiontolatlong!North
'qdf("Forms!F_locationconversiontolatlong!distancecntrl") = Forms!F_locationconversiontolatlong!Distancecntrl

Set rst = dbs.OpenRecordset("Select * from [" & pstrTableOrQueryName & "];", dbOpenForwardOnly)
If rst.EOF Then
    MsgBox "No records found for mapping", , "Multi-Location Mapper"
    GoTo Exit_Section
End If

strTempTableName = "tblMLMTemp1"

'* delete temp table
On Error Resume Next
DoCmd.DeleteObject acTable, strTempTableName
Err.Clear
On Error GoTo Err_Section

Marker = 4
If conMLMAdjustDuplicateMapPointPositions Then
    '* Initialize Latitude Longitude Knt (LLK) array
    For LLKSub = 0 To 400
        LLK(LLKSub).Knt = 0
    Next LLKSub
    LLKSub = -1
End If

i = 0
Do While Not rst.EOF
    i = i + 1

    Marker = 5
    dblLat = rst(pstrLatitudeFieldName)
    dblLng = rst(pstrLongitudeFieldName)
    
    Marker = 6
    strPhase = rst!Phase 'mb& ", " & rst!city & " " & rst!st
    'Debug.Print strPhase
    
    '* Available colors are:
    '*
    '* blue
    '* brown
    '* darkgreen
    '* green
    '* orange
    '* paleblue
    '* pink
    '* purple
    '* red
    '* yellow
    Marker = 7
    If Trim("" & rst(pstrMapPointColorFieldName)) = "" Then
        strColor = "red"
    Else
        Marker = 8
        strColor = rst(pstrMapPointColorFieldName)
    End If
    
    '* Can be any Capital letter of the English alphabet
    Marker = 9
    If Trim("" & rst(pstrMapPointLetterFieldName)) = "" Then
        strLetter = "A"
    Else
        Marker = 10
        strLetter = rst(pstrMapPointLetterFieldName)
    End If
    
    '* This is the text that pops up when the mouse cursor is over the map pin point marker
    Marker = 11
    If Trim("" & rst(pstrPopUpInfoFieldName)) = "" Then
        Marker = 12
        strPopUpInfo = strPhase & vbCrLf & "lat=" & dblLat & ", lng=" & dblLng
    Else
        Marker = 13
        strPopUpInfo = rst(pstrPopUpInfoFieldName)
    End If

'Debug.Print strPopUpInfo
    Marker = 14
    If conMLMAdjustDuplicateMapPointPositions Then
        Marker = 15
        FoundIt = False
        For j = 0 To 400
            If LLK(j).Knt = 0 Then Exit For
            If LLK(j).lat = dblLat And LLK(j).lng = dblLng Then
                FoundIt = True
                LLK(j).Knt = LLK(j).Knt + 1
                '* Make a slight adjustment to the map point latitude so that this map point
                '* won't completely cover a previous map point.
                dblLat = dblLat + (0.00005 * (LLK(j).Knt - 1))
                'dblLng = dblLng + (0.00005 * (LLK(j).Knt - 1))
                Exit For
            End If
        Next j
        If FoundIt Then
        Else
            Marker = 16
            LLKSub = LLKSub + 1
            If LLKSub > 400 Then
               ' Debug.Print "Some duplicate map points are hidden behind others. You may increase the size of the LLK array to fix this."
            Else
                LLK(LLKSub).lat = dblLat
                LLK(LLKSub).lng = dblLng
                LLK(LLKSub).Knt = 1
            End If
        End If
    End If
            
    '* v1.2
    If strDecimalPoint <> "." Then
        strLat = Replace(dblLat, strDecimalPoint, ".")
        strLng = Replace(dblLng, strDecimalPoint, ".")
    Else
        strLat = dblLat
        strLng = dblLng
    End If
        
    Marker = 17
    If i = 1 Then
        Marker = 18
        '* Create the temp table
        '* v1.2
        'strSQL = "Select " & dblLat & " as lat, " & dblLng & " as lng, '' as Location, '' as Color, '' as Letter, '' as PopUpInfo into [" & strTempTableName & "];"
        strsql = "Select " & strLat & " as lat, " & strLng & " as lng, '' as Phase, '' as Color, '' as Letter, '' as PopUpInfo into [" & strTempTableName & "];"
       ' Debug.Print strsql
        dbs.Execute strsql _
            , dbSeeChanges + dbFailOnError
        dbs.Execute "Delete * from [" & strTempTableName & "];"
    End If

    '* Update the temp table
    Marker = 19
    '* v1.2
    'strSQL = "Insert into [" & strTempTableName & "] " & _
        "(lat, lng, Location, Color, Letter, PopUpInfo) " & _
        "values " & _
        "(" & dblLat & ", " & dblLng & ", " & Chr(34) & strLocation & Chr(34) & ",'" & strColor & "', '" & strLetter & "', " & Chr(34) & strPopUpInfo & Chr(34) & ");"
    strsql = "Insert into [" & strTempTableName & "] " & _
        "(lat, lng, Phase, Color, Letter, PopUpInfo) " & _
        "values " & _
        "(" & strLat & ", " & strLng & ", " & Chr(34) & strPhase & Chr(34) & ",'" & strColor & "', '" & strLetter & "', " & Chr(34) & strPopUpInfo & Chr(34) & ");"
    
    'Debug.Print strSQL
    'Stop
    Marker = 20
    dbs.Execute strsql _
        , dbSeeChanges + dbFailOnError
    
    Marker = 21
    rst.movenext
Loop

'* output the temp table to a .csv file in the folder where the data back-end resides
Marker = 22

'strOutputFileName = "MapPoints2.csv"
FoundIt = False
For Each tdf In dbs.TableDefs
    If Trim("" & tdf.Connect) = "" Then
    Else
        'pddxxx fix bug.
        'If Left(tdf.Connect, Len(";Database=") = ";Database=") Then
        If Left(tdf.Connect, Len(";Database=")) = ";Database=" Then
            FoundIt = True
            Exit For
        End If
    End If
Next tdf
If FoundIt Then
    Marker = 23
    '* Found folder where application back-end resides
    strExistingTableName = tdf.Name
    strFolder = dbs.TableDefs(strExistingTableName).Connect
    strFolder = Replace(strFolder, ";Database=", "")
    strFolder = xg_GetFolderFromFilename(strFolder)
Else
    Marker = 24
    '* Could not find an application back-end table. Use location of application front-end
    strFolder = xg_GetFolderFromFilename(dbs.Name)
End If

'* Hard-code the location of the Multi-Location Mapper folder here, if needed
'strFolder = "C:\MyFolder\MySubfolder"

Marker = 25
If Dir(strFolder & "mlm*.*") = "" Then
    MsgBox "The Multi-Location Mapper library could not be found", , "Multi-Location Mapper"
    GoTo Exit_Section
End If

'* Remove any trailing "\"'s, if they exist.
For i = 1 To 2
    If Right(strFolder, 1) = "\" Then
        strFolder = Left(strFolder, Len(strFolder) - 1)
    End If
Next i

Marker = 26
'* Output the data to csv file
'* v1.2
'DoCmd.TransferText acExportDelim, , strTempTableName, strFolder & "\" & strOutputFileName
strOutputFileName = "MapPoints2.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, strTempTableName, strFolder & "\" & strOutputFileName, False

'* Call mapper
Marker = 27
'* Changed this section to use Shell for access runtime compatibility
If SysCmd(acSysCmdRuntime) Then
    Shell "cmd /c " & Chr(34) & strFolder & "\" & "mlm2000.mdb" & Chr(34), vbHide
Else
    Dim accapp As Access.Application
    Marker = 28
    Set accapp = New Access.Application
    Marker = 29
    accapp.OpenCurrentDatabase (strFolder & "\" & "mlm2000.mdb")
    Marker = 30
    accapp.Visible = True
End If


Marker = 99

Exit_Section:
    On Error Resume Next
    Set dbs = Nothing
    Set rst = Nothing
    Set qdf = Nothing
    Set tdf = Nothing
    fMLMMapIt = Rtn
    On Error GoTo 0
    Exit Function
Err_Section:
    Select Case Err
    Case Else
        Beep
        MsgBox "Error in fMLMMapIt (" & Marker & "), object " & Err.Source & ": " & Err.Number & " - " & Err.Description
    End Select
    Err.Clear
    Resume Exit_Section


End Function

thanks
 
The error your getting is what you get when the Querydefs are missing or aren't right so you are headed in the right direction. I can't tell what your problem is here, but I found out something interesting about QueryDefs just the other day. It seem that if you have a query, let's say query1, that uses another query, let's say query2, and query2 has parameters, then query1 needs to have the same parameters defined with the QueryDef for query1 too even though it has no parameters of its own.

That may not be your problem but it's probably good to be aware of this.
 
Thanks Sneuberg for your reply - that is interesting to know, and I will pursue it.
Matt
 
I hope you have this working by now, but in case you don't I noticed an error in the code you were trying. The lines like:

Code: 
qdf("Forms!F_LocationConversiontoLatlong!East") = Forms!F_locationconversiontolatlong!East

Should be like

Code: 
qdf.Parameters("Forms!F_LocationConversiontoLatlong!East") = Forms!F_locationconversiontolatlong!East
Also once you have a querydef defined if you want the open the recordset for it, it can be just

Code: 
Set rs = qdf.OpenRecordset
Although there are parameters in the OpenRecordset you can specify. See https://msdn.microsoft.com/en-us/library/office/ff822070.aspx
 
Thanks for your message. I've spent hours and hours and hours on this for the fifth night in a row, and I d'ont seem to be making any progress.....

I wonder if I might do better to run the query as SQL standalone and dim and refernece the variables directly in the VBA.....

What debug.print statement can I use to verify if my parameters are being picked up from the eg

Code: 
qdf.Parameters("Forms!F_LocationConversiontoLatlong!East") = Forms!F_LocationConversiontoLatlong!East
 
Try putting this after where the parameter is defined. It worked in my code.

Code: 
Dim parm As DAO.Parameter
For Each parm In qdf.Parameters
  Debug.Print parm.Value
Next parm
 
Last edited:
If you post your code as you have it now I'll take a look. Maybe I'll see something.
 
Thanks. I had another go at this last night, and after a couple of hours got the parameters to be recognised.
The change came when I specified the changed the name of the referenced query to just (pstrTableOrQueryName) without the " & etc:

Code: 
Set qdf = dbs.QueryDefs(pstrTableOrQueryName) '(" & pstrTableOrQueryName & ")


So on a Win 7 64 bit machine running Office 2013., the parameters are picked up. I took the database to work to run on another Win 7 machine running 2010, and the parameters are not getting picked up there. Very frustrating.

Although the debug shows the parameters are getting recognised on the 2013 system, the function still fails. The error I get is :

Code: 
Error in fMLMMapIt (3), object DAO.Database: 3061 - Too few parameters. Expected 3.

The 2 bound fields are 'East' and 'North'. I have tried switching around the bound control names to 'Eastcntrl' and 'Northcntrl' to differentiate control from field, but that doesn't help. It looks like the way of specifying a query def as
Code: 
Forms!F_LocationConversiontoLatlong!East
looks like its looking at the field not the control, but nonetheless, the the unbound control 'Distancecntrl' gets picked up without a 'Form.' prefix.

My debug print when I run successfully picks up East, Distancectnrl, and North (I guess in aplhabetical order rather than the order they are defined in (?)) from the open form (F_LocationConversiontoLatLong).

Debug example:

Code: 
Q_projects_latlong_markers
573900
2500
397800

So I've made progress - thanks for the help, but I've still yet to get the function to work with the queried dataset rather than the whole lot.

Here's the code:

Code: 
Function fMLMMapIt( _
     pstrTableOrQueryName As String _
    , Optional pstrLatitudeFieldName As String = "lat" _
    , Optional pstrLongitudeFieldName As String = "lng" _
    , Optional pstrMapPointColorFieldName As String = "MapPointColor" _
    , Optional pstrMapPointLetterFieldName As String = "MapPointLetter" _
    , Optional pstrPopUpInfoFieldName As String = "PopUpInfo" _
    ) As Integer
'******************************************************************************
'* Peter De Baets, author
'* 5/23/2011
'* This routine updates empty latitude and longitude field values in an "Addresses"
'* table. It first removes any apartment number in the address string (see query
'* "qryAddressesNoApt"), then uses the Google Geocoding API to get the lat and lng
'* values, then updates all rows of the Addresses table that have the same address
'* minus the apartment number. This method makes the most efficient use of the
'* Google Geocoding API.
'*
'* A reference to DAO, and Microsoft XML, v6.0 is required for this routine to run
'******************************************************************************
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim loc As LatLng
Dim Knt As Integer
Dim strsql As String
Dim strLastError As String
Dim intErr As Integer
Dim Rtn As Integer
Dim strTempTableName As String
Dim dblLat As Double
Dim dblLng As Double
Dim strPhase As String
Dim strColor As String
Dim strLetter As String
Dim strPopUpInfo As String
Dim LLK(400) As LatLng
Dim LLKSub As Integer
Dim FoundIt As Integer
Dim i As Integer
Dim j As Integer
Dim Marker As Integer

'v1.3
Dim strLat As String
Dim strLng As String
Dim strDecimalPoint As String
Dim strTempQueryName As String
Dim qdf As DAO.QueryDef
Dim strFolder As String
Dim strOutputFileName As String
Dim strExistingTableName As String
Dim tdf As DAO.TableDef

'mb
Dim prm As DAO.Parameter
'Dim East As Long
'Dim North As Long
'Dim Distancecntrl As Long
    
On Error GoTo Err_Section
Marker = 1

If fIsConnectedToInternet Then
Else
    GoTo Exit_Section
End If

Marker = 2
Set dbs = CurrentDb()
Marker = 3
Debug.Print pstrTableOrQueryName
    
'* v1.2
strDecimalPoint = Mid(CStr(3 / 2), 2, 1)


'mb added the following
Set qdf = dbs.QueryDefs(pstrTableOrQueryName) '(" & pstrTableOrQueryName & ")
 
qdf.Parameters("Forms!F_LocationConversiontoLatlong!East") = Forms!F_LocationConversiontoLatlong!East
qdf.Parameters("Forms!F_LocationConversiontoLatlong!North") = Forms!F_LocationConversiontoLatlong!North
qdf.Parameters("Forms!F_LocationConversiontoLatlong!Distancecntrl") = Forms!F_LocationConversiontoLatlong!Distancecntrl
    

'mb add
For Each prm In qdf.Parameters
 Debug.Print prm.Value
Next prm

Set rst = dbs.OpenRecordset("Select * from [" & pstrTableOrQueryName & "];", dbOpenForwardOnly) '" & pstrTableOrQueryName & "
If rst.EOF Then
    MsgBox "No records found for mapping", , "Multi-Location Mapper"
    GoTo Exit_Section
End If

strTempTableName = "tblMLMTemp1"

'* delete temp table
On Error Resume Next
DoCmd.DeleteObject acTable, strTempTableName
Err.Clear
On Error GoTo Err_Section

Marker = 4
If conMLMAdjustDuplicateMapPointPositions Then
    '* Initialize Latitude Longitude Knt (LLK) array
    For LLKSub = 0 To 400
        LLK(LLKSub).Knt = 0
    Next LLKSub
    LLKSub = -1
End If

i = 0
Do While Not rst.EOF
    i = i + 1

    Marker = 5
    dblLat = rst(pstrLatitudeFieldName)
    dblLng = rst(pstrLongitudeFieldName)
    
    Marker = 6
    strPhase = rst!Phase 'mb& ", " & rst!city & " " & rst!st
    'Debug.Print strPhase
    
    '* Available colors are:
    '*
    '* blue
    '* brown
    '* darkgreen
    '* green
    '* orange
    '* paleblue
    '* pink
    '* purple
    '* red
    '* yellow
    Marker = 7
    If Trim("" & rst(pstrMapPointColorFieldName)) = "" Then
        strColor = "red"
    Else
        Marker = 8
        strColor = rst(pstrMapPointColorFieldName)
    End If
    
    '* Can be any Capital letter of the English alphabet
    Marker = 9
    If Trim("" & rst(pstrMapPointLetterFieldName)) = "" Then
        strLetter = "A"
    Else
        Marker = 10
        strLetter = rst(pstrMapPointLetterFieldName)
    End If
    
    '* This is the text that pops up when the mouse cursor is over the map pin point marker
    Marker = 11
    If Trim("" & rst(pstrPopUpInfoFieldName)) = "" Then
        Marker = 12
        strPopUpInfo = strPhase & vbCrLf & "lat=" & dblLat & ", lng=" & dblLng
    Else
        Marker = 13
        strPopUpInfo = rst(pstrPopUpInfoFieldName)
    End If

'Debug.Print strPopUpInfo
    Marker = 14
    If conMLMAdjustDuplicateMapPointPositions Then
        Marker = 15
        FoundIt = False
        For j = 0 To 400
            If LLK(j).Knt = 0 Then Exit For
            If LLK(j).lat = dblLat And LLK(j).lng = dblLng Then
                FoundIt = True
                LLK(j).Knt = LLK(j).Knt + 1
                '* Make a slight adjustment to the map point latitude so that this map point
                '* won't completely cover a previous map point.
                dblLat = dblLat + (0.00005 * (LLK(j).Knt - 1))
                'dblLng = dblLng + (0.00005 * (LLK(j).Knt - 1))
                Exit For
            End If
        Next j
        If FoundIt Then
        Else
            Marker = 16
            LLKSub = LLKSub + 1
            If LLKSub > 400 Then
               ' Debug.Print "Some duplicate map points are hidden behind others. You may increase the size of the LLK array to fix this."
            Else
                LLK(LLKSub).lat = dblLat
                LLK(LLKSub).lng = dblLng
                LLK(LLKSub).Knt = 1
            End If
        End If
    End If
            
    '* v1.2
    If strDecimalPoint <> "." Then
        strLat = Replace(dblLat, strDecimalPoint, ".")
        strLng = Replace(dblLng, strDecimalPoint, ".")
    Else
        strLat = dblLat
        strLng = dblLng
    End If
        
    Marker = 17
    If i = 1 Then
        Marker = 18
        '* Create the temp table
        '* v1.2
        'strSQL = "Select " & dblLat & " as lat, " & dblLng & " as lng, '' as Location, '' as Color, '' as Letter, '' as PopUpInfo into [" & strTempTableName & "];"
        strsql = "Select " & strLat & " as lat, " & strLng & " as lng, '' as Phase, '' as Color, '' as Letter, '' as PopUpInfo into [" & strTempTableName & "];"
       ' Debug.Print strsql
        dbs.Execute strsql _
            , dbSeeChanges + dbFailOnError
        dbs.Execute "Delete * from [" & strTempTableName & "];"
    End If

    '* Update the temp table
    Marker = 19
    '* v1.2
    'strSQL = "Insert into [" & strTempTableName & "] " & _
        "(lat, lng, Location, Color, Letter, PopUpInfo) " & _
        "values " & _
        "(" & dblLat & ", " & dblLng & ", " & Chr(34) & strLocation & Chr(34) & ",'" & strColor & "', '" & strLetter & "', " & Chr(34) & strPopUpInfo & Chr(34) & ");"
    strsql = "Insert into [" & strTempTableName & "] " & _
        "(lat, lng, Phase, Color, Letter, PopUpInfo) " & _
        "values " & _
        "(" & strLat & ", " & strLng & ", " & Chr(34) & strPhase & Chr(34) & ",'" & strColor & "', '" & strLetter & "', " & Chr(34) & strPopUpInfo & Chr(34) & ");"
    
    'Debug.Print strSQL
    'Stop
    Marker = 20
    dbs.Execute strsql _
        , dbSeeChanges + dbFailOnError
    
    Marker = 21
    rst.movenext
Loop

'* output the temp table to a .csv file in the folder where the data back-end resides
Marker = 22

'strOutputFileName = "MapPoints2.csv"
FoundIt = False
For Each tdf In dbs.TableDefs
    If Trim("" & tdf.Connect) = "" Then
    Else
        'pddxxx fix bug.
        'If Left(tdf.Connect, Len(";Database=") = ";Database=") Then
        If Left(tdf.Connect, Len(";Database=")) = ";Database=" Then
            FoundIt = True
            Exit For
        End If
    End If
Next tdf
If FoundIt Then
    Marker = 23
    '* Found folder where application back-end resides
    strExistingTableName = tdf.Name
    strFolder = dbs.TableDefs(strExistingTableName).Connect
    strFolder = Replace(strFolder, ";Database=", "")
    strFolder = xg_GetFolderFromFilename(strFolder)
Else
    Marker = 24
    '* Could not find an application back-end table. Use location of application front-end
    strFolder = xg_GetFolderFromFilename(dbs.Name)
End If

'* Hard-code the location of the Multi-Location Mapper folder here, if needed
'strFolder = "C:\MyFolder\MySubfolder"

Marker = 25
If Dir(strFolder & "mlm*.*") = "" Then
    MsgBox "The Multi-Location Mapper library could not be found", , "Multi-Location Mapper"
    GoTo Exit_Section
End If

'* Remove any trailing "\"'s, if they exist.
For i = 1 To 2
    If Right(strFolder, 1) = "\" Then
        strFolder = Left(strFolder, Len(strFolder) - 1)
    End If
Next i

Marker = 26
'* Output the data to csv file
'* v1.2
'DoCmd.TransferText acExportDelim, , strTempTableName, strFolder & "\" & strOutputFileName
strOutputFileName = "MapPoints2.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, strTempTableName, strFolder & "\" & strOutputFileName, False

'* Call mapper
Marker = 27
'* Changed this section to use Shell for access runtime compatibility
If SysCmd(acSysCmdRuntime) Then
    Shell "cmd /c " & Chr(34) & strFolder & "\" & "mlm2000.mdb" & Chr(34), vbHide
Else
    Dim accapp As Access.Application
    Marker = 28
    Set accapp = New Access.Application
    Marker = 29
    accapp.OpenCurrentDatabase (strFolder & "\" & "mlm2000.mdb")
    Marker = 30
    accapp.Visible = True
End If


Marker = 99

Exit_Section:
    On Error Resume Next
    Set dbs = Nothing
    Set rst = Nothing
    Set qdf = Nothing
    Set tdf = Nothing
    fMLMMapIt = Rtn
    On Error GoTo 0
    Exit Function
Err_Section:
    Select Case Err
    Case Else
        Beep
        MsgBox "Error in fMLMMapIt (" & Marker & "), object " & Err.Source & ": " & Err.Number & " - " & Err.Description
    End Select
    Err.Clear
    Resume Exit_Section


End Function
 
Since you have a querydef for the record set I think this line

Code: 
Set rst = dbs.OpenRecordset("Select * from [" & pstrTableOrQueryName & "];", dbOpenForwardOnly) '" & pstrTableOrQueryName & "

Should be more like

Code: 
Set rst = [COLOR="Red"]qdf[/COLOR].OpenRecordSet

Although there are parameters in the OpenRecordset you can specify. See https://msdn.microsoft.com/en-us/lib.../ff822070.aspx The SQL is in the querydef already so there's no reason why it should be repeated.
 
You must log in or register to reply here.

Similar threads

N
VBA MS Access Error Handling
Replies
5
Views
592
Pat Hartman
P
W
CSV or XLSX Bank Statement to Access module (need to import via VBA and then write back to Excel with imported flag)
Replies
14
Views
1,894
Cotswold
Cotswold
Z
Assistance - Issue with Expression Function in SQL Query and Invoking Function in VBA Editor
Replies
4
Views
821
June7
June7
N
VBA code to search address on Google Maps
Replies
1
Views
1,517
Gasman
Gasman
R
Access DB attachments form and VBA
Replies
19
Views
2,310
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom