T
Tim Schiermeyer
I am trying to as fields within a table by name and not as an index number
within ADO is that possible. Here is a sample of the code I need to do this.
This was taken from F. Scott Barker's Book 'Access 2000 Power Programming'.
So listed is my code and then Barker's code. Listing the full code for I
might be missing something near the beginning. Here it is:
***************My ADO code*******************
Option Compare Database
Private Sub Export_m_Click()
Dim dbsLocal As ADODB.Connection
Dim CT As Recordset
Dim CurrAppDir As String
Dim FinalDoc As String
Dim FileOpenCmd As String
Dim EditReplace As String
Dim ReplaceWith As Variant
Dim Channel As Long
Dim ReturnValue As Long
Dim ExportString As String
Dim Year1, Month1, Day1 As Integer
On Error GoTo Error_Export_m_Click 'if any errors occur below this
point, jump happens
'--Get the applications path and establish the final filename
dbsLocal.Provider = "Microsoft.Jet.OLEDB.4.0"
Set dbsLocal = CurrentProject.Connection
CurrAppDir = CurrentProject.Path 'Sets current directory
On Error Resume Next
FinalDoc = CurrAppDir & "\TRBCLink_" & Month(Now) & "_" & Day(Now) & "_"
& _
Year(Now) & ".m" 'Sets name of path and file name
'With the current
embedded
Debug.Print FinalDoc
'-- If the final file is already there, delete it.
On Error Resume Next
Kill FinalDoc
On Error GoTo 0 'Error_cmdCreateLetter_Click
'-- Copy the template so it doesn't get written over.
FileCopy CurrAppDir & "\Backup.m", FinalDoc
Do
On Error Resume Next
Channel = DDEInitiate("TextPad", "System")
If Err.Number = 282 Then
On Error GoTo Error_Export_m_Click
'-- Open a copy of Word
ReturnValue = Shell("c:\Program Files\TextPad 4\TextPad.exe", 1)
ElseIf Err.Number > 0 Then
MsgBox "An error has occurred trying to start DDE", vbCritical, _
"Exiting Demo"
Exit Sub
End If
Loop While Channel = 0
'-- Open the file and then terminate the system channel
FileOpenCmd = "[open(""" & FinalDoc & """)]"
Debug.Print FileOpenCmd
DDEExecute Channel, FileOpenCmd
DDEExecute Channel, "[command(Append,""" & "Hello World" & """)]"
'DDETerminate Channel
'-- Create a channel directly to the document
'Channel = DDEInitiate("TextPad", FinalDoc)
DDEExecute Channel, "[command(Append,""" & "Hello World" & """)]"
'-- Open the table of replace codes then cycle through them.
Set CT = New ADODB.Recordset
CT.Open "T_BASE_CASE_RATING_GEN", _
dbsLocal, adOpenKeyset
Do While Not CT.EOF
'-- Return to the top of the document for each code.
ExportString = "[command(Append,""" & "OLDBUSD," & _
CT!OID.Value & "," & CT!BC_Name(Reg).Value & """]"
DDEExecute Channel, "[command(Append,""" & "Inside loop" & """)]"
Debug.Print ExportString
Debug.Print "Hello"
Debug.Print CT.GetString
Debug.Print CT.Fields("OID").Value
DDEExecute Channel, ExportString
CT.MoveNext
Loop
DDETerminate Channel
CT.Close
Exit Sub
Error_Export_m_Click:
Beep
MsgBox "The Following Error has occurred:" & vbCrLf & _
Err.Description, vbCritical, "DDE Error!"
Exit Sub
End Sub
******************************Scotts code****************************
Private Sub cmdCreateLetter_Click()
Dim dbLocal As Database
Dim snpReplaceCodes As Recordset
Dim strCurrAppDir As String
Dim strFinalDoc As String
Dim strFileOpenCmd As String
Dim strEditReplace As String
Dim varReplaceWith As Variant
Dim lngChannel As Long
Dim lngReturnValue As Long
On Error GoTo Error_cmdCreateLetter_Click
'-- Get the applications path and establish the final file name
Set dbLocal = CurrentDb()
strCurrAppDir = Left$(dbLocal.Name, InStr(dbLocal.Name, _
"\Chap13.mdb") - 1)
strFinalDoc = strCurrAppDir & "\DemoTest.doc"
'-- If the final file is already there, delete it.
On Error Resume Next
Kill strFinalDoc
On Error GoTo 0 'Error_cmdCreateLetter_Click
'-- Copy the template so it doesn't get written over.
FileCopy strCurrAppDir & "\WordDemo.DOT", strFinalDoc
Do
On Error Resume Next
lngChannel = DDEInitiate("WinWord", "System")
If Err.Number = 282 Then
On Error GoTo Error_cmdCreateLetter_Click
'-- Open a copy of Word
lngReturnValue = Shell(ap_FindExe("DemoTest.doc", strCurrAppDir),
1)
ElseIf Err.Number > 0 Then
MsgBox "An error has occurred trying to start DDE", vbCritical, _
"Exiting Demo"
Exit Sub
End If
Loop While lngChannel = 0
'-- Open the file and then terminate the system channel
strFileOpenCmd = "[FileOpen """ & strFinalDoc & """]"
DDEExecute lngChannel, strFileOpenCmd
DDETerminate lngChannel
'-- Create a channel directly to the document
lngChannel = DDEInitiate("WinWord", strFinalDoc)
'-- Open the table of replace codes then cycle through them.
Set snpReplaceCodes = dbLocal.OpenRecordset("tblDDEWordReplaceCodes", _
dbOpenSnapshot)
Do While Not snpReplaceCodes.EOF
'-- Return to the top of the document for each code.
DDEExecute lngChannel, "[StartOfDocument]"
'-- Get the actual value to replace with, then use the
'-- Word replace.
varReplaceWith = Eval(snpReplaceCodes!ReplaceWithFieldName)
strEditReplace = "[EditReplace """ & snpReplaceCodes!CodeToReplace _
& """, """ & IIf(IsNull(varReplaceWith), " ", _
CStr(varReplaceWith)) & """,.ReplaceOne]"
DDEExecute lngChannel, strEditReplace
'-- If the current replace code is the movie title,
'-- set bold and italics.
If snpReplaceCodes!CodeToReplace = "{MOVIETITLE}" Then
DDEExecute lngChannel, "[StartOfDocument]"
DDEExecute lngChannel, "[EditFind """ & varReplaceWith & """]"
DDEExecute lngChannel, "[Italic]"
DDEExecute lngChannel, "[Bold]"
DDEExecute lngChannel, "[SetSelRange 0, 0]"
End If
snpReplaceCodes.MoveNext
Loop
DDETerminate lngChannel
snpReplaceCodes.Close
Exit Sub
Error_cmdCreateLetter_Click:
Beep
MsgBox "The Following Error has occurred:" & vbCrLf & _
Err.Description, vbCritical, "DDE Error!"
Exit Sub
End Sub
within ADO is that possible. Here is a sample of the code I need to do this.
This was taken from F. Scott Barker's Book 'Access 2000 Power Programming'.
So listed is my code and then Barker's code. Listing the full code for I
might be missing something near the beginning. Here it is:
***************My ADO code*******************
Option Compare Database
Private Sub Export_m_Click()
Dim dbsLocal As ADODB.Connection
Dim CT As Recordset
Dim CurrAppDir As String
Dim FinalDoc As String
Dim FileOpenCmd As String
Dim EditReplace As String
Dim ReplaceWith As Variant
Dim Channel As Long
Dim ReturnValue As Long
Dim ExportString As String
Dim Year1, Month1, Day1 As Integer
On Error GoTo Error_Export_m_Click 'if any errors occur below this
point, jump happens
'--Get the applications path and establish the final filename
dbsLocal.Provider = "Microsoft.Jet.OLEDB.4.0"
Set dbsLocal = CurrentProject.Connection
CurrAppDir = CurrentProject.Path 'Sets current directory
On Error Resume Next
FinalDoc = CurrAppDir & "\TRBCLink_" & Month(Now) & "_" & Day(Now) & "_"
& _
Year(Now) & ".m" 'Sets name of path and file name
'With the current
embedded
Debug.Print FinalDoc
'-- If the final file is already there, delete it.
On Error Resume Next
Kill FinalDoc
On Error GoTo 0 'Error_cmdCreateLetter_Click
'-- Copy the template so it doesn't get written over.
FileCopy CurrAppDir & "\Backup.m", FinalDoc
Do
On Error Resume Next
Channel = DDEInitiate("TextPad", "System")
If Err.Number = 282 Then
On Error GoTo Error_Export_m_Click
'-- Open a copy of Word
ReturnValue = Shell("c:\Program Files\TextPad 4\TextPad.exe", 1)
ElseIf Err.Number > 0 Then
MsgBox "An error has occurred trying to start DDE", vbCritical, _
"Exiting Demo"
Exit Sub
End If
Loop While Channel = 0
'-- Open the file and then terminate the system channel
FileOpenCmd = "[open(""" & FinalDoc & """)]"
Debug.Print FileOpenCmd
DDEExecute Channel, FileOpenCmd
DDEExecute Channel, "[command(Append,""" & "Hello World" & """)]"
'DDETerminate Channel
'-- Create a channel directly to the document
'Channel = DDEInitiate("TextPad", FinalDoc)
DDEExecute Channel, "[command(Append,""" & "Hello World" & """)]"
'-- Open the table of replace codes then cycle through them.
Set CT = New ADODB.Recordset
CT.Open "T_BASE_CASE_RATING_GEN", _
dbsLocal, adOpenKeyset
Do While Not CT.EOF
'-- Return to the top of the document for each code.
ExportString = "[command(Append,""" & "OLDBUSD," & _
CT!OID.Value & "," & CT!BC_Name(Reg).Value & """]"
DDEExecute Channel, "[command(Append,""" & "Inside loop" & """)]"
Debug.Print ExportString
Debug.Print "Hello"
Debug.Print CT.GetString
Debug.Print CT.Fields("OID").Value
DDEExecute Channel, ExportString
CT.MoveNext
Loop
DDETerminate Channel
CT.Close
Exit Sub
Error_Export_m_Click:
Beep
MsgBox "The Following Error has occurred:" & vbCrLf & _
Err.Description, vbCritical, "DDE Error!"
Exit Sub
End Sub
******************************Scotts code****************************
Private Sub cmdCreateLetter_Click()
Dim dbLocal As Database
Dim snpReplaceCodes As Recordset
Dim strCurrAppDir As String
Dim strFinalDoc As String
Dim strFileOpenCmd As String
Dim strEditReplace As String
Dim varReplaceWith As Variant
Dim lngChannel As Long
Dim lngReturnValue As Long
On Error GoTo Error_cmdCreateLetter_Click
'-- Get the applications path and establish the final file name
Set dbLocal = CurrentDb()
strCurrAppDir = Left$(dbLocal.Name, InStr(dbLocal.Name, _
"\Chap13.mdb") - 1)
strFinalDoc = strCurrAppDir & "\DemoTest.doc"
'-- If the final file is already there, delete it.
On Error Resume Next
Kill strFinalDoc
On Error GoTo 0 'Error_cmdCreateLetter_Click
'-- Copy the template so it doesn't get written over.
FileCopy strCurrAppDir & "\WordDemo.DOT", strFinalDoc
Do
On Error Resume Next
lngChannel = DDEInitiate("WinWord", "System")
If Err.Number = 282 Then
On Error GoTo Error_cmdCreateLetter_Click
'-- Open a copy of Word
lngReturnValue = Shell(ap_FindExe("DemoTest.doc", strCurrAppDir),
1)
ElseIf Err.Number > 0 Then
MsgBox "An error has occurred trying to start DDE", vbCritical, _
"Exiting Demo"
Exit Sub
End If
Loop While lngChannel = 0
'-- Open the file and then terminate the system channel
strFileOpenCmd = "[FileOpen """ & strFinalDoc & """]"
DDEExecute lngChannel, strFileOpenCmd
DDETerminate lngChannel
'-- Create a channel directly to the document
lngChannel = DDEInitiate("WinWord", strFinalDoc)
'-- Open the table of replace codes then cycle through them.
Set snpReplaceCodes = dbLocal.OpenRecordset("tblDDEWordReplaceCodes", _
dbOpenSnapshot)
Do While Not snpReplaceCodes.EOF
'-- Return to the top of the document for each code.
DDEExecute lngChannel, "[StartOfDocument]"
'-- Get the actual value to replace with, then use the
'-- Word replace.
varReplaceWith = Eval(snpReplaceCodes!ReplaceWithFieldName)
strEditReplace = "[EditReplace """ & snpReplaceCodes!CodeToReplace _
& """, """ & IIf(IsNull(varReplaceWith), " ", _
CStr(varReplaceWith)) & """,.ReplaceOne]"
DDEExecute lngChannel, strEditReplace
'-- If the current replace code is the movie title,
'-- set bold and italics.
If snpReplaceCodes!CodeToReplace = "{MOVIETITLE}" Then
DDEExecute lngChannel, "[StartOfDocument]"
DDEExecute lngChannel, "[EditFind """ & varReplaceWith & """]"
DDEExecute lngChannel, "[Italic]"
DDEExecute lngChannel, "[Bold]"
DDEExecute lngChannel, "[SetSelRange 0, 0]"
End If
snpReplaceCodes.MoveNext
Loop
DDETerminate lngChannel
snpReplaceCodes.Close
Exit Sub
Error_cmdCreateLetter_Click:
Beep
MsgBox "The Following Error has occurred:" & vbCrLf & _
Err.Description, vbCritical, "DDE Error!"
Exit Sub
End Sub