Solved Pass AutoNumberID from Access table to Outlook

[TheKid]

Hello, From Outlook VBA using DAO I’ve got Access to start a new record in tblTravelFolder. While still in the same Outlook module i would like to use that new record ID from the tblTravelFolder as an variable for some other outlook functionality. Apologies I don’t know the term to use to “get back the ID”

 

[cheekybuddha]

>> using DAO I’ve got Access to start a new record in tblTravelFolder <<

Can you post this code?

Normally you do something like:

Dim db As DAO.Database, strSQL As String, lNewID As Long
Const dbFailOnError As Integer = 128   ' Comment out if you have set a DAO reference

Set db = ...
With db
  strSQL = "INSERT INTO tblTravelFolder (Field1, Field2) Values (" & Value1 & ", " & Value2 & ");"
  .Execute strSQL, dbFailOnError
  strSQL = "SELECT @@IDENTITY;"
  With .OpenRecordset(strSQL)
    lNewID = .Fields(0)
    .Close
  End With
End With
' Do something with the new ID
Debug.Print lNewID
Set db = Nothing

 

[TheKid]

As request David. Sorry its still very much in test mode

'General Declarations
Declare Function SetFocusAPI Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long

Private Sub TestMakeNewTravelFolder_Click()
'Code by Daniel Pineault https://www.devhut.net/2018/08/26/access-vba-inserting-new-records/

'''''TODOLIST'''''
'1 Get New Travel Folder ID (TFID) from Hermes
'2 MkDir from TFID in H:\
'3 Mark category as DB logged (blue) and the new TFID to UserProperties
'4 Move to outlook folder hermes > new enquires
'5 Save msg to TF
'6 Save msg details to tbltravelfolderACTIONS  
'7 Open frmTF_Enquiry 

'''' MAKE SURE HERMES IS OPEN ''''
 On Error GoTo Error_Handler
 Dim appAccess As Object
 Set appAccess = GetObject("C:\Hermes\DB\TEST_HermesFE.accdb")
  If Err.Number <> 0 Then
 'The database was not open so open it
 Set appAccess = CreateObject("Access.Application")
 Err.Clear
 End If
    
'1 Get New TFID from Hermes
 Dim db                    As DAO.Database
 Dim rs                    As DAO.Recordset
 Set db = CurrentDb
 Set rs = db.OpenRecordset("tblTravelFolder")
   With rs
    .AddNew
    ![CID] = "17794"    'Test value
          .Update
    End With
'' Need TFID back from Hermes to:-
' MkDir /  Add New TFID to UserProperties

'2 MkDir from TFID in H:\
'''Need TFID from Hermes

'Dim strHermesTFID As String
' strHermesTFID = ???????
'Dim strTFName As String
'strTFName = "H:\TFID" & ("srtHermesTFID")
'If Len(Dir(strTFName, vbDirectory)) = 0 Then
'   MkDir strTFName
'End If
'' Open folder to check again?
'   Shell "C:\WINDOWS\explorer.exe """ & strTFName & "", vbNormalFocus

Error_Handler_Exit:
    On Error Resume Next
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then Set db = Nothing
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: cmd_AddRec_Click" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

 

[cheekybuddha]

You probably can just grab the value since you are using a recordset. See if this works:

' ...
'1 Get New TFID from Hermes
 Dim db                    As DAO.Database
 Dim rs                    As DAO.Recordset
 Dim lTFID                 As Long
 Set db = CurrentDb
 Set rs = db.OpenRecordset("tblTravelFolder")
   With rs
    .AddNew
    ![CID] = "17794"    'Test value
    .Update
    lTFID = !TFID    ' <-- grab value here
    End With
' ...

 

[TheKid]

when i added a Debug.Print TFID it returns the First ID not the New TFID

 

[cheekybuddha]

Is this code in Outlook, or Access?

If in Outlook, I guess you don't want CurrentDb.

Try adjusting like:

' ...
  On Error GoTo Error_Handler

  Dim appAccess       As Object
  Dim rs              As DAO.Recordset
  Dim strSQL          As String
  Dim lTFID           As Long
  Const dbFailOnError As Integer = 128

  Set appAccess = GetObject("C:\Hermes\DB\TEST_HermesFE.accdb")
  If Err.Number <> 0 Then
  ' The database was not open so open it
    Err.Clear
    Set appAccess = CreateObject("Access.Application")
    appAccess.OpenCurrentDatabase("C:\Hermes\DB\TEST_HermesFE.accdb")    '  <-- This bit was missing
  End If
  With appAccess.DBEngine(0)(0)
    strSQL = "INSERT INTO tblTravelFolder (CID) VALUES (17794);"    ' Test value
    .Execute strSQL, dbFailOnError
    strSQL = "SELECT @@IDENTITY;"
    With .OpenRecordset(strSQL)
      lTFID = .Fields(0)
      .Close
    End With
  End With
' Do something with the new ID
  Debug.Print lTFID

' ...

 

[TheKid]

If in Outlook, I guess you don't want CurrentDb.

Defo Outlook side, must have left it in from some other code.

Your last option worked after i removed the 1 from the 1TFID Intellisense didn't like it. I presume that's ok?

 

[Gasman]

That is not a 1 but a lowercase L for long I believe?

 

[TheKid]

oh dear oh dear. optician time me thinks

 

[cheekybuddha]

after i removed the 1 from the 1TFID Intellisense didn't like it. I presume that's ok?

That is not a 1 but a lowercase L

I'm glad it worked for you!

 

[Gasman]

oh dear oh dear. optician time me thinks

No, they almost identical