.MoveNext not working

C

chuckcoleman

Registered User.
Local time
Today, 09:48
Joined
Aug 20, 2010
Messages
377
Hi, I'm stumped. I am trying to get VBA to loop through a table that is created, but it never moves past the first record after the loop. The table that is created for the test I'm running has two records in it. The code writes the first persons contact information to the Outlook Contacts twice. It doesn't go to the second record. Here is the code. Your help will be appreciated.

Dim MyDB As Database, rs As Recordset
Dim CustomerID As Long
Dim rstFiltered As DAO.Recordset
Dim FName As String
Dim LName As String
Dim Address As String
Dim Address2 As String
Dim City As String
Dim State As String
Dim ZIP As String
Dim CustomerTel As String
Dim CustomerEmail As String
Dim TransferredTo As Boolean
Dim lngRSCount As Long

Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set rs = MyDB.OpenRecordset("Temp Email and Tel Table for Outlook")
lngRSCount = rs.RecordCount

DoCmd.SetWarnings False
DoCmd.OpenQuery "Delete Temp Email and Tel Table for Outlook"
DoCmd.Close acQuery, "Delete Temp Email and Tel Table for Outlook"
DoCmd.OpenQuery "Append FName to TempOutlook Table"
DoCmd.Close acQuery, "Append FName to TempOutlook Table"
DoCmd.OpenQuery "Append FName2 to TempOutlook Table"
DoCmd.Close acQuery, "Append FName2 to TempOutlook Table"
DoCmd.SetWarnings True

If lngRSCount = 0 Then
MsgBox ("There aren't any contacts to send to Outlook.")
Exit Function
Else
MsgBox ("1-The value of lngRSCount is: " & lngRSCount)
rs.MoveLast
rs.MoveFirst
With rs 'first With
Do Until .EOF
FirstName = Nz(DLookup("FName", "Temp Email and Tel Table for Outlook"))
LastName = Nz(DLookup("LName", "Temp Email and Tel Table for Outlook"))
AddrStreet = Nz(DLookup("Address", "Temp Email and Tel Table for Outlook"))
AddrStreet2 = Nz(DLookup("Address2", "Temp Email and Tel Table for Outlook"))
AddrCity = Nz(DLookup("City", "Temp Email and Tel Table for Outlook"))
AddrState = Nz(DLookup("State", "Temp Email and Tel Table for Outlook"))
AddrZIP = Nz(DLookup("ZIP", "Temp Email and Tel Table for Outlook"))
CustomerTel = Nz(DLookup("Telephone", "Temp Email and Tel Table for Outlook"))
CustomerEmail = Nz(DLookup("Email", "Temp Email and Tel Table for Outlook"))
MsgBox ("2-The value of FName is: " & FirstName)

If TransferredTo = True Then
MsgBox ("This contact has already been added to your Outlook Contacts. " _
& " If you want to make a change and send it to Outlook, uncheck the 'Transfered " _
& " to Outlook' checkmark, make your change and then click on 'Send Contact to Outlook'. " _
& " Please note, when you do this, you will have a duplicate contact in Outlook and you should " _
& " probably delete the older contact.")
Exit Function
End If

#Const EarlyBind = False 'True = Use Early Binding
'False = Use Late Binding
#If EarlyBind = True Then
'Early Binding Declarations
'Requires Ref to Microsoft Outlook XX.X Object Library
Dim oOutlook As Outlook.Application
Dim olContact As Outlook.ContactItem
#Else
'Late Binding Declaration/Constants
Dim olApp As Object
Dim olContact As Object
Const olContactItem = 2
#End If

Set olApp = CreateObject("Outlook.Application")
Set olContact = olApp.CreateItem(olContactItem)

With olContact
.FirstName = FirstName
.LastName = LastName
.FullName = FirstName & ", " & LastName
.FileAs = LastName & ", " & FirstName
.JobTitle = JobTitles
.CompanyName = CompName
.HomeAddressStreet = AddrStreet
.HomeAddressCity = AddrCity
.HomeAddressState = AddrState
.HomeAddressPostalCode = AddrZIP
.BusinessTelephoneNumber = ContactTel
.Email1Address = CustomerEmail
.MobileTelephoneNumber = CustomerTel
.Save
' .Display 'Uncomment if you wish the user to see the contact pop-up
MsgBox ("Thank you, I have filed " & FirstName & " " & LastName & "'s contact information in Outlook.")
End With
.MoveNext
MsgBox ("7-I'm about to loop")
Loop
End With 'Ends first With
End If

rs.Close
MyDB.Close
Set rs = Nothing
Set MyDB = Nothing
Close

Error_Handler_Exit:
On Error Resume Next
If Not olContact Is Nothing Then Set olContact = Nothing
If Not olApp Is Nothing Then Set olApp = Nothing
Exit Function

Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: AddOlContact" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
 
Last edited:
Perhaps if you indented the code, the error would be obvious? :(
 
Gasman said:
Perhaps if you indented the code, the error would be obvious? :(
Click to expand...
Sorry. What I pasted was indented. After your feedback/comment I edited the code and indented it some more. After saving it the site left-justifies everything. So, the error still isn't obvious. I attached a txt file of the code if that is helpful, with indents.
 

Attachments

You need to use code tags :(
See my signature.

You have been on this site over 11 years? :unsure:
The old site used # for code tags as other sites still do.

Again, I would walk through the code with F8, to see where the code goes?
 
1. Please use code tags
2. I would increase your test record set to be > 2 if you are wanting to test looping
 
Code: 
    Dim MyDB As Database, rs As Recordset
    Dim CustomerID As Long
    Dim rstFiltered As DAO.Recordset
    Dim FName As String
    Dim LName As String
    Dim Address As String
    Dim Address2 As String
    Dim City As String
    Dim State As String
    Dim ZIP As String
    Dim CustomerTel As String
    Dim CustomerEmail As String
    Dim TransferredTo As Boolean
    Dim lngRSCount As Long
    
    Set MyDB = DBEngine.Workspaces(0).Databases(0)
    Set rs = MyDB.OpenRecordset("Temp Email and Tel Table for Outlook")
    lngRSCount = rs.RecordCount
        
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "Delete Temp Email and Tel Table for Outlook"
    DoCmd.Close acQuery, "Delete Temp Email and Tel Table for Outlook"
    DoCmd.OpenQuery "Append FName to TempOutlook Table"
    DoCmd.Close acQuery, "Append FName to TempOutlook Table"
    DoCmd.OpenQuery "Append FName2 to TempOutlook Table"
    DoCmd.Close acQuery, "Append FName2 to TempOutlook Table"
    DoCmd.SetWarnings True
  
    If lngRSCount = 0 Then
     MsgBox ("There aren't any contacts to send to Outlook.")
     Exit Function
    Else
     MsgBox ("1-The value of lngRSCount is: " & lngRSCount)
     rs.MoveLast
     rs.MoveFirst
    With rs 'first With
     Do Until .EOF
      FirstName = Nz(DLookup("FName", "Temp Email and Tel Table for Outlook"))
      LastName = Nz(DLookup("LName", "Temp Email and Tel Table for Outlook"))
      AddrStreet = Nz(DLookup("Address", "Temp Email and Tel Table for Outlook"))
      AddrStreet2 = Nz(DLookup("Address2", "Temp Email and Tel Table for Outlook"))
      AddrCity = Nz(DLookup("City", "Temp Email and Tel Table for Outlook"))
      AddrState = Nz(DLookup("State", "Temp Email and Tel Table for Outlook"))
      AddrZIP = Nz(DLookup("ZIP", "Temp Email and Tel Table for Outlook"))
      CustomerTel = Nz(DLookup("Telephone", "Temp Email and Tel Table for Outlook"))
      CustomerEmail = Nz(DLookup("Email", "Temp Email and Tel Table for Outlook"))
      MsgBox ("2-The value of FName is: " & FirstName)

      If TransferredTo = True Then
       MsgBox ("This contact has already been added to your Outlook Contacts. " _
       & " If you want to make a change and send it to Outlook, uncheck the 'Transfered " _
       & " to Outlook' checkmark, make your change and then click on 'Send Contact to Outlook'. " _
       & " Please note, when you do this, you will have a duplicate contact in Outlook and you should " _
       & " probably delete the older contact.")
       Exit Function
      End If

    #Const EarlyBind = False    'True  = Use Early Binding
                                'False = Use Late Binding
    #If EarlyBind = True Then
        'Early Binding Declarations
        'Requires Ref to Microsoft Outlook XX.X Object Library
        Dim oOutlook          As Outlook.Application
        Dim olContact         As Outlook.ContactItem
    #Else
        'Late Binding Declaration/Constants
        Dim olApp             As Object
        Dim olContact         As Object
        Const olContactItem = 2
    #End If
 
    Set olApp = CreateObject("Outlook.Application")
    Set olContact = olApp.CreateItem(olContactItem)

     With olContact
     .FirstName = FirstName
     .LastName = LastName
     .FullName = FirstName & ", " & LastName
     .FileAs = LastName & ", " & FirstName
     .JobTitle = JobTitles
     .CompanyName = CompName
     .HomeAddressStreet = AddrStreet
     .HomeAddressCity = AddrCity
     .HomeAddressState = AddrState
     .HomeAddressPostalCode = AddrZIP
     .BusinessTelephoneNumber = ContactTel
     .Email1Address = CustomerEmail
     .MobileTelephoneNumber = CustomerTel
     .Save
      ' .Display  'Uncomment if you wish the user to see the contact pop-up
      MsgBox ("Thank you, I have filed " & FirstName & " " & LastName & "'s contact information in Outlook.")
     End With
    .MoveNext
    MsgBox ("7-I'm about to loop")
    Loop
    End With 'Ends first With
   End If

    rs.Close
    MyDB.Close
    Set rs = Nothing
    Set MyDB = Nothing
    Close

Error_Handler_Exit:
    On Error Resume Next
    If Not olContact Is Nothing Then Set olContact = Nothing
    If Not olApp Is Nothing Then Set olApp = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: AddOlContact" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function
 
JMongi said:
1. Please use code tags
2. I would increase your test record set to be > 2 if you are wanting to test looping
Click to expand...
I increased the number of records. No change. Still picks just the first record.
 
Your indented post doesn't seem to follow indenting protocol. For example your first With statement is on the same level as the If statement it is contained within.

Here is my super quick indentation of your code (could be errors).

Code: 
Dim MyDB As Database, rs As Recordset
Dim CustomerID As Long
Dim rstFiltered As DAO.Recordset
Dim FName As String
Dim LName As String
Dim Address As String
Dim Address2 As String
Dim City As String
Dim State As String
Dim ZIP As String
Dim CustomerTel As String
Dim CustomerEmail As String
Dim TransferredTo As Boolean
Dim lngRSCount As Long

Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set rs = MyDB.OpenRecordset("Temp Email and Tel Table for Outlook")
lngRSCount = rs.RecordCount

DoCmd.SetWarnings False
DoCmd.OpenQuery "Delete Temp Email and Tel Table for Outlook"
DoCmd.Close acQuery, "Delete Temp Email and Tel Table for Outlook"
DoCmd.OpenQuery "Append FName to TempOutlook Table"
DoCmd.Close acQuery, "Append FName to TempOutlook Table"
DoCmd.OpenQuery "Append FName2 to TempOutlook Table"
DoCmd.Close acQuery, "Append FName2 to TempOutlook Table"
DoCmd.SetWarnings True

If lngRSCount = 0 Then
    MsgBox ("There aren't any contacts to send to Outlook.")
    Exit Function
Else
    MsgBox ("1-The value of lngRSCount is: " & lngRSCount)
    rs.MoveLast
    rs.MoveFirst
    With rs 'first With
        Do Until .EOF
            FirstName = Nz(DLookup("FName", "Temp Email and Tel Table for Outlook"))
            LastName = Nz(DLookup("LName", "Temp Email and Tel Table for Outlook"))
            AddrStreet = Nz(DLookup("Address", "Temp Email and Tel Table for Outlook"))
            AddrStreet2 = Nz(DLookup("Address2", "Temp Email and Tel Table for Outlook"))
            AddrCity = Nz(DLookup("City", "Temp Email and Tel Table for Outlook"))
            AddrState = Nz(DLookup("State", "Temp Email and Tel Table for Outlook"))
            AddrZIP = Nz(DLookup("ZIP", "Temp Email and Tel Table for Outlook"))
            CustomerTel = Nz(DLookup("Telephone", "Temp Email and Tel Table for Outlook"))
            CustomerEmail = Nz(DLookup("Email", "Temp Email and Tel Table for Outlook"))
            MsgBox ("2-The value of FName is: " & FirstName)

            If TransferredTo = True Then
                MsgBox ("This contact has already been added to your Outlook Contacts. " _
                & " If you want to make a change and send it to Outlook, uncheck the 'Transfered " _
                & " to Outlook' checkmark, make your change and then click on 'Send Contact to Outlook'. " _
                & " Please note, when you do this, you will have a duplicate contact in Outlook and you should " _
                & " probably delete the older contact.")
                Exit Function
            End If

            #Const EarlyBind = False 'True = Use Early Binding
            'False = Use Late Binding
            #If EarlyBind = True Then
                'Early Binding Declarations
                'Requires Ref to Microsoft Outlook XX.X Object Library
                Dim oOutlook As Outlook.Application
                Dim olContact As Outlook.ContactItem
            #Else
                'Late Binding Declaration/Constants
                Dim olApp As Object
                Dim olContact As Object
                Const olContactItem = 2
            #End If

            Set olApp = CreateObject("Outlook.Application")
            Set olContact = olApp.CreateItem(olContactItem)

            With olContact
                .FirstName = FirstName
                .LastName = LastName
                .FullName = FirstName & ", " & LastName
                .FileAs = LastName & ", " & FirstName
                .JobTitle = JobTitles
                .CompanyName = CompName
                .HomeAddressStreet = AddrStreet
                .HomeAddressCity = AddrCity
                .HomeAddressState = AddrState
                .HomeAddressPostalCode = AddrZIP
                .BusinessTelephoneNumber = ContactTel
                .Email1Address = CustomerEmail
                .MobileTelephoneNumber = CustomerTel
                .Save
                ' .Display 'Uncomment if you wish the user to see the contact pop-up
                MsgBox ("Thank you, I have filed " & FirstName & " " & LastName & "'s contact information in Outlook.")
            End With
            .MoveNext
            MsgBox ("7-I'm about to loop")
        Loop
    End With 'Ends first With
End If

rs.Close
MyDB.Close
Set rs = Nothing
Set MyDB = Nothing
Close

Error_Handler_Exit:
    On Error Resume Next
    If Not olContact Is Nothing Then Set olContact = Nothing
    If Not olApp Is Nothing Then Set olApp = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
    "Error Number: " & Err.Number & vbCrLf & _
    "Error Source: AddOlContact" & vbCrLf & _
    "Error Description: " & Err.Description & _
    Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
    , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
    
End Function
 
I cannot see anything offhand, which is why I always walk through the code next.?
I do not believe you can get an accurate record count of a recordset, unless you MoveLast before getting RecordCount ?
 
The fact that it writes the contact twice indicates there is a larger problem as it appears this code has a mechanism that is supposed to prevent duplicate contacts from being created and yet it does. As @Gasman is saying, set a breakpoint in your code and step through the code (using F8) and you should see the looping/lack of looping as well as the failure of the anti-duplication code block.
 
First, I cant see any on error statement in your code.
If your logic is incorrect, and you never get to the .movenext then you will only read one record.
Do you get any errors when this runs?

What is the purpose of the queries immediately after you open the record set, and before the loop starts.?
Maybe they need to come before you open the record set
 
gemma-the-husky said:
First, I cant see any on error statement in your code.
If your logic is incorrect, and you never get to the .movenext then you will only read one record.
Do you get any errors when this runs?

What is the purpose of the queries immediately after you open the record set, and before the loop starts.?
Maybe they need to come before you open the record set
Click to expand...
The queries establish which records/contacts to add to Outlook. The queries work perfectly. I can see the table after it's repopulated and the data in it is correct. I'll check the other suggestions as well.
 
Code: 
Set rs = MyDB.OpenRecordset("Temp Email and Tel Table for Outlook")

you run this, and then run the outlook queries. This might change the Temp Email table, but I would think the recordset is already stored in memory. (not 100% sure of this). What value do you get for lngRSCount

Perhaps open and display the query "Temp Email and Tel Table for Outlook" at that point, to check the contents.

maybe make the .movenext explicitly rs.movenext.
And then as already pointed out, step through the code to see what happens after you save the contact.
 
I believe .MoveNext only works if the next record is not a new one. In your case, if there are only 2 records, then if will not work.
 
gemma-the-husky said:
Code: 
Set rs = MyDB.OpenRecordset("Temp Email and Tel Table for Outlook")

you run this, and then run the outlook queries. This might change the Temp Email table, but I would think the recordset is already stored in memory. (not 100% sure of this). What value do you get for lngRSCount

Perhaps open and display the query "Temp Email and Tel Table for Outlook" at that point, to check the contents.

maybe make the .movenext explicitly rs.movenext.
And then as already pointed out, step through the code to see what happens after you save the contact.
Click to expand...
Well, I'm still stumped. I moved the queries to right after the DIM statements, (they should have been there), to make sure they are executed before the rest of the code. The contents of the temp table are correct. I changed the .movenext to rs.movenext. As far as stepping, maybe I'm not using it correctly, but if I put my cursor on the line with "loop", the code runs and then stops at the "loop" line and "loop" is selected in yellow. That doesn't tell me anything. Also, lngRSCount isn't really used for anything other than verifying the number of records.
 
LarryE said:
I believe .MoveNext only works if the next record is not a new one. In your case, if there are only 2 records, then if will not work.
Click to expand...
If I run the queries before the rest of the code starts, aren't the records "old", not "new"?
 
lngRSCount isn't really used for anything other than verifying the number of records.
Click to expand...
Which it cannot do if it is wrong, can it? That's why you need to verify with a debug.print what it is.

As far as stepping, maybe I'm not using it correctly, but if I put my cursor on the line with "loop", the code runs and then stops at the "loop" line and "loop" is selected in yellow.
Click to expand...
Set a breakpoint. That will automatically engage the debugger when the code is running. Then pressing F8 will execute the next line of code. Press F8 again to execute next line and so forth. Step through each line in your code until the function is completely through. It should loop through your loop as many times as its supposed to, not just once. Debug.Print commands will show in the Immediate window so you can use them to check what is stored in variables as the code is executed.
 
apologies if someone already said this, I got a headache reading through the thread but I did try:

you can't get a reliable recordcount on a dao recordset until FIRST (not last) moving last and then first.

keep that in mind
 
Honestly, this whole code block seems strange. Stuff is in the wrong place or the wrong order like the .movelast and .movefirst coming after you try to set the recordcount. You have detailed error handling but no On Error in the appropriate place. You have an If/Then code block checking a local boolean variable that isn't set or changed anywhere. You have a fairly detailed/complex block of code including conditional operators but don't know how to use the debugger? You Dim a recordset that isn't used. It all seems a bit strange.
 
Well I would be doing all the normal stuff?
Does Movenext work where the first and last are? Put a breakpoint on that .MoveNext. in the immediate window debug.print the ID, execute that line and then debug.print the ID again.
Debug print the ID of the record each time within the loop.
I'd be putting a Debug.Print ID in that loop and see what is produced.?
 
You must log in or register to reply here.

Similar threads

B
Outlook - Filtered Unread, Server duplicate emails & think Unread = False not work so errors
Replies
6
Views
281
bignose2
B
K
DLookup to return different value on MoveNext
Replies
5
Views
204
ebs17
E
oxicottin
Solved Out Of Memory error when emailing
Replies
8
Views
249
oxicottin
oxicottin
K
Solved Rec.MoveNext not working?
Replies
4
Views
213
kevnaff
K
C
Invalid Use of Null
2
Replies
20
Views
1,093
chuckcoleman
C

Users who are viewing this thread

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