Creosote65
Technical User
Hi all,
In the following code, I am exporting data to Word, into a new table. To direct the data copy to the proper point in the document, I am using a variable called "rngInsertionPoint". The first time I run this macro, everything runs fine. The second time, I get an error '264' (Remote Server does not exist or is unavailable). I cannot eliminate this error until I quit and reopen the Access application.
I am aware that the main problem is that I am opening multiple instances of "rngInsertionPoint". However, I can't figure out at which point I should be changing a declaration into a "with" statement.
I am listing the macro with line numbers. If anyone can tell me which declaration is causing the error 264, I will make the proper changes.
Thanks,
Creo
1 Dim appWord As Word.Application
2 Dim docWord As Word.Document
3 Dim rngInsertionPoint As Word.Range
4 Dim rstContractHeader As New ADODB.Recordset
5 Dim rstContractDetails As New ADODB.Recordset
6 Dim strContractNo As String
7 Dim strCATNo As String
8 Dim lngProjVol As Long
9 Dim strItemCode As String
10 Dim strDescription As String
11 Dim strSellingUOM As String
12 Dim lngConversion As Long
13 Dim curPropSel As Currency
14 On Error GoTo ExportError
15 'Open the header recordset
16 DoCmd.SetWarnings False
17 DoCmd.OpenQuery "qryExportContrNoEng", acViewNormal, acReadOnly
18 rstContractHeader.Open "tblExportContrNoEng", _
19 CurrentProject.Connection, adOpenStatic
20 'Set current contract and CAT numbers as strings
21 With rstContractHeader
22 If IsNull(.Fields("ContrNo")) Then 'End if the value is null.
23 MsgBox "The quote contains no contract number. Please enter this information and retry."
24 DoCmd.OpenForm "frmMenuContrEng"
25 DoCmd.Close acForm, "frmChooseQuoteExpArchContrEng", acSaveNo
26 Exit Sub
27 Else
28 strContractNo = .Fields("ContrNo")
29 End If
30 strCATNo = .Fields("ReqNo")
31 End With
32 'Open Word and create a new document
33 Set appWord = New Word.Application
34 appWord.Documents.Add
35 Set docWord = appWord.Documents(1)
36 docWord.Application.Visible = True
37 'Add a 3 column table to the tables collection
38 Set rngInsertionPoint = docWord.Paragraphs(1).Range
39 With rngInsertionPoint
40 .Collapse Direction:=wdCollapseEnd
41 .Tables.Add rngInsertionPoint, 1, 3
42 End With
43 'Add Column titles
44 With rngInsertionPoint.Tables(1).Rows(1)
45 .Cells(1).Range.Text = "PRODUCT PRICING"
46 .Cells(2).Range.Text = "EXHIBIT C"
47 .Cells(3).Range.Text = "CONTRACT " & strContractNo
48 .Range.Bold = True
49 .Range.Font.Name = "Times New Roman"
50 .Range.Font.Size = 8
51 End With
52 'Add a line for CAT id
53 rngInsertionPoint.Tables(1).Rows.Add
54 With rngInsertionPoint.Tables(1).Rows.Last
.Cells(3).Range.Text = "CAT" & strCATNo
55 End With
56 DoCmd.Close acTable, "tblExportContrNoEng", acSaveNo
57 'Add a 6 column table to the tables collection (Item details output)
58 Set rngInsertionPoint = docWord.Paragraphs(7).Range
59 docWord.Paragraphs.Add
60 Set rngInsertionPoint = docWord.Paragraphs(8).Range
61 With rngInsertionPoint
62 .Collapse Direction:=wdCollapseEnd
63 .Tables.Add rngInsertionPoint, 1, 6
64 End With
65 'Add column Titles
66 Set rngInsertionPoint = docWord.Paragraphs(2).Range
67 With rngInsertionPoint.Tables(1).Rows(3)
68 .Cells(1).Range.Text = "Estimated Annual Usage"
69 .Cells(2).Range.Text = "Product Code"
70 .Cells(3).Range.Text = "Description"
71 .Cells(4).Range.Text = "UOM"
72 .Cells(5).Range.Text = "Quantity per UOM"
73 .Cells(6).Range.Text = "Price/UOM"
74 .Range.Font.Name = "Times New Roman"
75 .Range.Font.Size = 8
76 .Cells(1).Width = InchesToPoints(0.8)
77 .Cells(2).Width = InchesToPoints(0.8)
78 .Cells(3).Width = InchesToPoints(2.6)
79 .Cells(4).Width = InchesToPoints(0.5)
80 .Cells(5).Width = InchesToPoints(0.7)
81 .Cells(6).Width = InchesToPoints(0.75)
82 End With
83 rngInsertionPoint.Tables(1).Rows.Last.Borders.Enable = True
84 'Open the detail recordset
85 DoCmd.OpenQuery "qryExportDetailEng", acViewNormal, acReadOnly
86 rstContractDetails.Open "tblExportDetailEng", _
87 CurrentProject.Connection, adOpenStatic
88 'Place values in the table
89 With rstContractDetails
90 Do While .EOF = False
91 lngProjVol = .Fields("ProjVol")
92 strItemCode = .Fields("Item Code")
93 If IsNull(.Fields("Description")) Then 'End if the value is null
94 appWord.Quit False
95 'Set appWord = Nothing
96 MsgBox "Item code " & strItemCode & " is invalid. Please correct this information and retry."
97 DoCmd.OpenForm "frmMenuContrEng"
98 DoCmd.Close acForm, "frmChooseQuoteExpArchContrEng", acSaveNo
99 Exit Sub
100 End If
101 strDescription = .Fields("Description")
102 strSellingUOM = .Fields("Selling UOM")
103 lngConversion = .Fields("Smallest to Selling")
104 curPropSel = .Fields("PropSel")
105 'Add a row to the table
106 rngInsertionPoint.Tables(1).Rows.Add
107 'Place values in the table
108 With rngInsertionPoint.Tables(1).Rows.Last
109 .Cells(1).Range.Text = lngProjVol
110 .Cells(2).Range.Text = strItemCode
111 .Cells(3).Range.Text = strDescription
113 .Cells(4).Range.Text = strSellingUOM
114 .Cells(5).Range.Text = lngConversion
115 .Cells(6).Range.Text = Format(curPropSel, "Currency")
116 End With
117 .MoveNext
118 Loop
119 rngInsertionPoint.Tables(1).Rows(3).Range.Bold = True
120 End With
121 'Close Word
122 appWord.Quit
123 Set appWord = Nothing
124 'Run the Archive and delete queries
125 'DoCmd.OpenQuery "qryArchiveHeaderEng", acViewNormal, acReadOnly
126 'DoCmd.OpenQuery "qryArchiveItemDetailEng", acViewNormal, acReadOnly
127 'DoCmd.OpenQuery "qryDeleteInputEng"
128 DoCmd.OpenForm "frmMenuContrEng"
129 DoCmd.Close acForm, "frmChooseQuoteExpArchContrEng"
130 ExportError:
131 If Err.Number = 462 Then
132 'Word is still open from previous export.
133 appWord.Quit False
134 Set appWord = Nothing
135 MsgBox "The export has failed. Please try again.", vbExclamation, "Export Error"
136 DoCmd.OpenForm "frmMenuContrEng"
137 DoCmd.Close acForm, "frmChooseQuoteExpArchContrEng", acSaveNo
138 Exit Sub
139 End If
140 End Sub
In the following code, I am exporting data to Word, into a new table. To direct the data copy to the proper point in the document, I am using a variable called "rngInsertionPoint". The first time I run this macro, everything runs fine. The second time, I get an error '264' (Remote Server does not exist or is unavailable). I cannot eliminate this error until I quit and reopen the Access application.
I am aware that the main problem is that I am opening multiple instances of "rngInsertionPoint". However, I can't figure out at which point I should be changing a declaration into a "with" statement.
I am listing the macro with line numbers. If anyone can tell me which declaration is causing the error 264, I will make the proper changes.
Thanks,
Creo
1 Dim appWord As Word.Application
2 Dim docWord As Word.Document
3 Dim rngInsertionPoint As Word.Range
4 Dim rstContractHeader As New ADODB.Recordset
5 Dim rstContractDetails As New ADODB.Recordset
6 Dim strContractNo As String
7 Dim strCATNo As String
8 Dim lngProjVol As Long
9 Dim strItemCode As String
10 Dim strDescription As String
11 Dim strSellingUOM As String
12 Dim lngConversion As Long
13 Dim curPropSel As Currency
14 On Error GoTo ExportError
15 'Open the header recordset
16 DoCmd.SetWarnings False
17 DoCmd.OpenQuery "qryExportContrNoEng", acViewNormal, acReadOnly
18 rstContractHeader.Open "tblExportContrNoEng", _
19 CurrentProject.Connection, adOpenStatic
20 'Set current contract and CAT numbers as strings
21 With rstContractHeader
22 If IsNull(.Fields("ContrNo")) Then 'End if the value is null.
23 MsgBox "The quote contains no contract number. Please enter this information and retry."
24 DoCmd.OpenForm "frmMenuContrEng"
25 DoCmd.Close acForm, "frmChooseQuoteExpArchContrEng", acSaveNo
26 Exit Sub
27 Else
28 strContractNo = .Fields("ContrNo")
29 End If
30 strCATNo = .Fields("ReqNo")
31 End With
32 'Open Word and create a new document
33 Set appWord = New Word.Application
34 appWord.Documents.Add
35 Set docWord = appWord.Documents(1)
36 docWord.Application.Visible = True
37 'Add a 3 column table to the tables collection
38 Set rngInsertionPoint = docWord.Paragraphs(1).Range
39 With rngInsertionPoint
40 .Collapse Direction:=wdCollapseEnd
41 .Tables.Add rngInsertionPoint, 1, 3
42 End With
43 'Add Column titles
44 With rngInsertionPoint.Tables(1).Rows(1)
45 .Cells(1).Range.Text = "PRODUCT PRICING"
46 .Cells(2).Range.Text = "EXHIBIT C"
47 .Cells(3).Range.Text = "CONTRACT " & strContractNo
48 .Range.Bold = True
49 .Range.Font.Name = "Times New Roman"
50 .Range.Font.Size = 8
51 End With
52 'Add a line for CAT id
53 rngInsertionPoint.Tables(1).Rows.Add
54 With rngInsertionPoint.Tables(1).Rows.Last
.Cells(3).Range.Text = "CAT" & strCATNo
55 End With
56 DoCmd.Close acTable, "tblExportContrNoEng", acSaveNo
57 'Add a 6 column table to the tables collection (Item details output)
58 Set rngInsertionPoint = docWord.Paragraphs(7).Range
59 docWord.Paragraphs.Add
60 Set rngInsertionPoint = docWord.Paragraphs(8).Range
61 With rngInsertionPoint
62 .Collapse Direction:=wdCollapseEnd
63 .Tables.Add rngInsertionPoint, 1, 6
64 End With
65 'Add column Titles
66 Set rngInsertionPoint = docWord.Paragraphs(2).Range
67 With rngInsertionPoint.Tables(1).Rows(3)
68 .Cells(1).Range.Text = "Estimated Annual Usage"
69 .Cells(2).Range.Text = "Product Code"
70 .Cells(3).Range.Text = "Description"
71 .Cells(4).Range.Text = "UOM"
72 .Cells(5).Range.Text = "Quantity per UOM"
73 .Cells(6).Range.Text = "Price/UOM"
74 .Range.Font.Name = "Times New Roman"
75 .Range.Font.Size = 8
76 .Cells(1).Width = InchesToPoints(0.8)
77 .Cells(2).Width = InchesToPoints(0.8)
78 .Cells(3).Width = InchesToPoints(2.6)
79 .Cells(4).Width = InchesToPoints(0.5)
80 .Cells(5).Width = InchesToPoints(0.7)
81 .Cells(6).Width = InchesToPoints(0.75)
82 End With
83 rngInsertionPoint.Tables(1).Rows.Last.Borders.Enable = True
84 'Open the detail recordset
85 DoCmd.OpenQuery "qryExportDetailEng", acViewNormal, acReadOnly
86 rstContractDetails.Open "tblExportDetailEng", _
87 CurrentProject.Connection, adOpenStatic
88 'Place values in the table
89 With rstContractDetails
90 Do While .EOF = False
91 lngProjVol = .Fields("ProjVol")
92 strItemCode = .Fields("Item Code")
93 If IsNull(.Fields("Description")) Then 'End if the value is null
94 appWord.Quit False
95 'Set appWord = Nothing
96 MsgBox "Item code " & strItemCode & " is invalid. Please correct this information and retry."
97 DoCmd.OpenForm "frmMenuContrEng"
98 DoCmd.Close acForm, "frmChooseQuoteExpArchContrEng", acSaveNo
99 Exit Sub
100 End If
101 strDescription = .Fields("Description")
102 strSellingUOM = .Fields("Selling UOM")
103 lngConversion = .Fields("Smallest to Selling")
104 curPropSel = .Fields("PropSel")
105 'Add a row to the table
106 rngInsertionPoint.Tables(1).Rows.Add
107 'Place values in the table
108 With rngInsertionPoint.Tables(1).Rows.Last
109 .Cells(1).Range.Text = lngProjVol
110 .Cells(2).Range.Text = strItemCode
111 .Cells(3).Range.Text = strDescription
113 .Cells(4).Range.Text = strSellingUOM
114 .Cells(5).Range.Text = lngConversion
115 .Cells(6).Range.Text = Format(curPropSel, "Currency")
116 End With
117 .MoveNext
118 Loop
119 rngInsertionPoint.Tables(1).Rows(3).Range.Bold = True
120 End With
121 'Close Word
122 appWord.Quit
123 Set appWord = Nothing
124 'Run the Archive and delete queries
125 'DoCmd.OpenQuery "qryArchiveHeaderEng", acViewNormal, acReadOnly
126 'DoCmd.OpenQuery "qryArchiveItemDetailEng", acViewNormal, acReadOnly
127 'DoCmd.OpenQuery "qryDeleteInputEng"
128 DoCmd.OpenForm "frmMenuContrEng"
129 DoCmd.Close acForm, "frmChooseQuoteExpArchContrEng"
130 ExportError:
131 If Err.Number = 462 Then
132 'Word is still open from previous export.
133 appWord.Quit False
134 Set appWord = Nothing
135 MsgBox "The export has failed. Please try again.", vbExclamation, "Export Error"
136 DoCmd.OpenForm "frmMenuContrEng"
137 DoCmd.Close acForm, "frmChooseQuoteExpArchContrEng", acSaveNo
138 Exit Sub
139 End If
140 End Sub