Server cannot be found error

[Macjnr]

Teh code below is used for doing a mail merge. It works well the 1st time but spits out an error that the database cannot be found when invoked the 2nd time.

Why would this be happening ?

Public Function LTRCOL_letter()
Dim oMainDoc As Word.Document
Dim oSel As Word.Selection
Dim sDBPath As String

Set oApp = CreateObject("Word.Application")

If oMainDoc Is Nothing Then
Set oMainDoc = oApp.Documents.Open("C:\Documents and Settings\Chris\Desktop\Letter_Access\Templates\LTRCOL.doc")
End If
oApp.Visible = False 'set connection as visible

With oMainDoc.MailMerge
.MainDocumentType = wdFormLetters
sDBPath = AssignDbPath

.OpenDataSource Name:=sDBPath, _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatRTF, _
Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0; " & _
"User ID=Admin;" & _
"Password='';" & _
"Data Source=" & sDBPath & ";" & _
"Mode=Read;", _
SQLStatement:="SELECT * FROM `" & "LTRCOL" & "`", SQLStatement1:="", _
Subtype:=wdMergeSubTypeAccess
End With

If oMainDoc.MailMerge.DataSource.RecordCount > 0 Then
Call cmdGo_Click(oMainDoc.MailMerge.DataSource.RecordCount)
With oMainDoc
.MailMerge.Destination = wdSendToNewDocument
.ActiveWindow.ActivePane.View.Type = wdPrintView
.MailMerge.Execute
.Close (0)
End With

FileName = "LTRCOL" & "_" & Format(Date, "ddmmyyyy") & "_" & Format(Time, "mmhhss")

oApp.Application.Documents(1).SaveAs "C:\Documents and Settings\Chris\Desktop\Letter_Access\Output" & "\" & FileName & ".rtf"
oApp.Documents.Parent.Visible = False
oApp.Application.WindowState = wdWindowStateMinimize
oApp.ActiveWindow.WindowState = wdWindowStateMinimize
oApp.Quit (0)

Set oMainDoc = Nothing
Set oApp = Nothing
Set Rs2 = CurrentDb.OpenRecordset("AuditTrail")

Rs2.AddNew
Rs2("Filename") = TextF
Rs2("Processedby") = Environ("username")
Rs2("DateProcessed") = Format(Date, "dd/mm/yyyy")
Rs2("CountofRecords") = DCount("[Letter_code]", "LTRCOL")
Rs2("Letter_Code") = "LTRCOL"
Rs2("SavedAs") = FileName
Rs2.Update
Rs2.Close
Set Rs2 = Nothing
Else
oApp.Quit (0)
Set oMainDoc = Nothing
Set oApp = Nothing
Set Rs2 = Nothing
End If
End Function

Thank you in advance for the help.

 

[bulrush]

You don't even have any error trapping. We need to know which line created the error.

Just before End Function put this code:

Exit sub
MyError:
msgbox("Error in procname")
Resume Next

And just after variable declarations at the top of your procedure put this:

On error goto Myerror

Now rerun and tell us which line gave you the error when you ran the code the 2nd time.

 

[NigelShaw]

Without sifting through your code in depth, I did notice you are not declaring RS2 as anything. This should be a recordset. You are also not declaring a db though you call it when setting rs2.

Have you closed your recordsets and other objects opened?
seems like something might still be open.

Nidge

 

[bulrush]

Rs2 and Db could be global variables, but the OP did not say that.