Question : Copy email into network folder

Hi Experts,

I need Experts help. Ever since I changed my Oulook from 2003 into 2007, seems like the attached script no longer working. I’m using this code to copy the sent item into network if the subject title is “TK:”. Hope Experts can help me to troubleshoot this.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
Dim WithEvents olkFolder As Outlook.Items

Private Sub Application_Quit()
    Set olkFolder = Nothing
End Sub

Private Sub Application_Startup()
    Set olkFolder = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub olkFolder_ItemAdd(ByVal Item As Object)
    'Edit the condition on the next line'
      If InStr(1, Item.Subject, "TK:") Then
        'Edit the folder path on the next line'
        Item.SaveAs "\\bc04\Main\Data\Folder\" & RemoveIllegalCharacters(Item.Subject) & ".msg", olMSG
    End If
End Sub

Function RemoveIllegalCharacters(strValue As String) As String
    ' Purpose: Remove characters that cannot be in a filename from a string.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    RemoveIllegalCharacters = strValue
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "")
End Function

Answer : Copy email into network folder

> At the core of both link functions is exactly the same proceedure as I've posted above ..

No, because you call CurrentDb multiple times where you should call it once only.
Here is how for attaching tables in a backend file located in the same folder as the frontend.
You can easily modify it using the path for the backend as a parameter.

/gustav
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
  Dim dbs As DAO.Database
  Dim tdf As DAO.TableDef
  
  Dim strSourceTableName  As String
  Dim strCurrentPath      As String
  Dim strAttachPath       As String
  Dim strFrontendPath     As String
  Dim strBackendPath      As String
  Dim strConnect          As String
  
  On Error GoTo Err_GentilknytData
  
  Set dbs = CurrentDb
  
  strFrontendPath = dbs.Name
  strCurrentPath = Mid(strFrontendPath, 1, InStrRev(strFrontendPath, "\") - 1)

  For Each tdf In dbs.TableDefs
    strSourceTableName = tdf.SourceTableName
    If Len(strSourceTableName) > 0 Then
      strBackendPath = Split(tdf.Connect, "=")(1)
      strAttachPath = Mid(strBackendPath, 1, InStrRev(strBackendPath, "\") - 1)
      If StrComp(strCurrentPath, strAttachPath, vbTextCompare) <> 0 Then
        strConnect = ";DATABASE=" & strCurrentPath & "\AktivitetData.mdb"
        tdf.Connect = strConnect
        tdf.RefreshLink
      End If
    End If
  Next

  Set tdf = Nothing
  Set dbs = Nothing
  
Random Solutions  
 
programming4us programming4us