Converting from DAO to ADO confusion

  • Thread starter Thread starter Tim Schiermeyer
  • Start date Start date
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
 
to reference a field by name use

dim fld as field
for fld in ct
debug.print fld.name
next

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
Click to expand...
 
Back
Top