vb code office 97

[bsl1973]

I am new to a company and they have a program written in office 97 and we want to change the code so it is written in office 2003. It crashes if the end user does not have office 97. I am networking guy so I am not sure how to change the code but here it is:

'ach3
Dim Text, MName, Phone, Fax, Contact1 As String
Dim InputFile As String
Dim F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, F11, F12, F13, F14, F15, F16, F17, F18, F19, F20, F21, F22, F23, F24, F25, F26, F27 As String



Public Sub CreateDocs_Click()
InputFile = FileFromCommerce.Text
If Dir(FileFromCommerce.Text) <> "" Then
StatusList.AddItem "Opening " & InputFile
Open InputFile For Input As #1
Input #1, Text
Line Input #1, Header
If Text = "CompanyID" Then
StatusList.AddItem "File is correct structure"
'StatusList.AddItem " kareem"
BreakdownFile
CloseRecords
Else
StatusList.AddItem "File is Not formatted correctly"
End If
Else
StatusList.AddItem InputFile & " is not a valid filename"
End If
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
On Error Resume Next
Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_DblClick()
Dim a1Slash, a2Slash As Integer
a1Slash = InStr(File1.Path, "\")
a2Slash = InStr(a1Slash + 1, File1.Path, "\")

If Len(File1.Path) > a1Slash Then
FileFromCommerce.Text = File1.Path & "\" & File1.FileName
Else
FileFromCommerce.Text = File1.Path & File1.FileName
End If

End Sub
Private Sub Form_Load()
Drive1.Drive = "U:\"
Dir1.Path = "\\Cps1\Transfer\ACH Returns\"
End Sub
Public Sub BreakdownFile()
'StatusList.AddItem "first line"
Dim TTF, TextHeader As String
TTF = "\\cps1\transfer\ACH Returns\ACH Bounce Program\TheTextFile.txt"
Kill TTF
Open TTF For Output As #2
'StatusList.AddItem "open ttf"
TextHeader = "Contact_Employee_Name, Company, Fax_Number, Phone_Number, Reason, Amount, ID, Effective_Date, Header, Account, Routing_Number, Individual_Name, Reason_Given, Addenda"
Print #2, TextHeader
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL, Path As String
strSQL = "SELECT * From [Merge Data];"
Path = "\\cps1\transfer\ACH Returns\ACH Bounce Program\mergable datum.mdb"
Set db = DBEngine.Workspaces(0).OpenDatabase(Path)
Set rs = db.OpenRecordset(strSQL)
Dim FindCP As Integer
Dim FinalText As String
Dim Count As Integer
Count = 0
Do While Not EOF(1)
Input #1, F1
Input #1, F2
Input #1, F3
Input #1, F4
Input #1, F5
Input #1, F6
Input #1, F7
Input #1, F8
Input #1, F9
Input #1, F10
Input #1, F11
Input #1, F12
Input #1, F13
Input #1, F14
Input #1, F15
Input #1, F16
Input #1, F17
If Trim(F17) = "" Then
F17 = "(N/A)"
End If
Input #1, F18
Input #1, F19
Input #1, F20
Input #1, F21
Input #1, F22
Input #1, F23
Input #1, F24
F24 = Mid(F24, 3, 2) & "/" & Right(F24, 2) & "/" & "20" & Left(F24, 2)
Input #1, F25
Input #1, F26
Input #1, F27
Count = Count + 1
'StatusList.AddItem " right before returnbeginstring"
ReturnBeginString (F23)
'Print #2, ReturnString & "Direct Deposit Bounce" & ", " & F12 & ", " & Trim(F22) & ", " & F24 & ", " & Trim(Replace(F23, ",", " ")) & ", " & Trim(F11) & ", " & Trim(F18 & F19) & ", " & Replace(F13, ",", " ") & ", " & F15 & ", " & F16 & ", " & Trim(F17)
rs.AddNew
rs("Contact Employee Name") = Contact1
rs("DateStamp") = Format(Now)
rs("SourceFile") = FileFromCommerce.Text
rs("Company") = MName
rs("Fax Number") = Fax
rs("Phone Number") = Phone
rs("Reason") = "Direct Deposit Return"
rs("Amount") = F12 / 100
rs("ID") = Trim(F22)
rs("Effective Date") = F24
rs("Header") = Trim(Replace(F23, ",", ""))
rs("Account") = Trim(F11)
rs("Routing Number") = Trim(F18 & F19)
rs("Individual Name") = Replace(F13, ",", "")
rs("Trace Number") = F15
rs("Reason Code") = F16
rs("Reason Given") = F21
If IsNull(Trim(F17)) = False Then
rs("Addenda") = Trim(F17)
Else
rs("Addenda") = "N/A"
End If
If CStr(F16) = "C02" And IsNull(Trim(F17)) <> True Then
rs("Instructions") = "Please correct the transit/routing number using the "
End If
Print #2, rs("Contact Employee Name") & ", " & rs("Company") & ", " & rs("Fax Number") & ", " & rs("Phone Number") & ", " & rs("Reason") & ", " & rs("Amount") & ", " & rs("ID") & ", " & rs("Effective Date") & ", " & rs("Header") & ", " & rs("Account") & ", " & rs("Routing Number") & ", " & rs("Individual Name") & ", " & rs("Reason Given") & ", " & rs("addenda")
rs.Update
StatusList.AddItem "ACH Bounce for " & Trim(Left(F23, 5)) & " was created successfully!"
Loop
Close #2
StatusList.AddItem "There were " & Count & " bounces processed!"
StatusList.AddItem "Creating merged document..."
CreateDocument
End Sub

Public Sub ReturnBeginString(Comp As String)
Dim WhereSpace As Integer
Dim Company, Path, MyFile, MyFile2 As String
WhereSpace = InStr(Comp, " ")
Company = Left(Comp, WhereSpace - 1)

Dim cnn1 As ADODB.Connection
Dim rstADO1 As ADODB.Recordset
Dim strCnn As String

strCnn = "Provider=sqloledb;" & _
"Data Source=CPS21;Initial Catalog=Millennium;User Id=sa;Password=Z0lTan1; "

Set cnn1 = New ADODB.Connection
cnn1.Open strCnn

p = "SELECT * FROM CInfo WHERE CInfo.co = '" & Company & "';"

Set rstADO1 = New ADODB.Recordset
rstADO1.CursorType = adOpenKeyset
rstADO1.LockType = adLockOptimistic
rstADO1.Open p, cnn1, , , adCmdText

If rstADO1.RecordCount > 0 Then
MName = Replace(rstADO1("name"), ",", "")
Phone = rstADO1("Phone")
Fax = rstADO1("fax")
If IsNull(rstADO1("Contact1")) = False Then
Contact1 = Replace(rstADO1("Contact1"), ",", "")
ElseIf IsNull(rstADO1("Contact2")) = False Then
Contact1 = Replace(rstADO1("Contact2"), ",", "")
ElseIf IsNull(rstADO1("Contact3")) = False Then
Contact1 = Replace(rstADO1("Contact3"), ",", "")
End If
'End If
Else
'Dim WhereSpace As Integer
''Dim Company, Path, MyFile, MyFile2 As String
'WhereSpace = InStr(Comp, " ")
'Company = Left(Comp, WhereSpace - 1)

'StatusList.AddItem InputFile & " after ado"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT * FROM SCInfo WHERE SCInfo.id = '" & Company & "';"
Path = "\\cps1\payroll\system\prsys.mdb"
Set db = DBEngine.Workspaces(0).OpenDatabase(Path)
Set rs = db.OpenRecordset(strSQL)
MName = Replace(rs("name"), ",", "")
Phone = rs("MainPhone")
Fax = rs("Mainfax")
If IsNull(rs("Contact1")) = False Then
Contact1 = Replace(rs("Contact1"), ",", "")
ElseIf IsNull(rs("Contact2")) = False Then
Contact1 = Replace(rs("Contact2"), ",", "")
ElseIf IsNull(rs("Contact3")) = False Then
Contact1 = Replace(rs("Contact3"), ",", "")
End If
rs.Close

End If
End Sub

Public Sub CreateDocument()
Set doc = CreateObject("Word.Application")
'Set doc = New Word.Application
doc.Application.Visible = True
doc.Documents.Open ("\\cps1\transfer\ACH Returns\ACH Bounce Program\blank.doc")

'Word.ActiveDocument.MailMerge.Destination = wdSendToPrinter
'Word.ActiveDocument.MailMerge.Destination = wdSendToNewDocument
Word.ActiveDocument.MailMerge.Execute
StatusList.AddItem "Merge Successful..."
End Sub

Public Sub CloseRecords()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT [Merge data].Merged From [Merge data] WHERE ((([Merge data].Merged)=No));"
Path = "\\cps1\transfer\ACH Returns\ACH Bounce Program\mergable datum.mdb"
Set db = DBEngine.Workspaces(0).OpenDatabase(Path)
Set rs = db.OpenRecordset(strSQL)
StatusList.AddItem "Closing remaining records for next bounce list..."
Do While rs.EOF <> True
rs.Edit
rs("merged") = True
rs.Update
rs.MoveNext
Loop
End Sub

 

[HughLerwill]

On which line is the code failing (if it begins to run at all) and what error is shown?

 

[HughLerwill]

Apologies for telling you this after responding but you should be posting this in forum707

 

[BobRodes]

<Dim F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, F11, F12, F13, F14, F15, F16, F17, F18, F19, F20, F21, F22, F23, F24, F25, F26, F27 As String
In this example, only F27 is a string, the rest are variants.

 

[JoeAtWork]

Code that works in Access97 usually works in 2003, there were no real changes between the versions.

I suspect all you need to get the code working again is to reference the DAO library (Tools -> References from within the VBA editor window).

 

[bsl1973]

Here is the error: Run-time error '-2147023174 (800706ba)':
Automation error

 

[JoeAtWork]

On which line is the error occurring?

Did you make sure there was a reference to set DAO?

 

[bsl1973]

This is where it fails:


Set doc = CreateObject("Word.Application")
'Set doc = New Word.Application

 

[SkipVought]

Is this VB that you compile into an .exe or are you running this from some Office application?

The former belongs in this forum.

The latter should be posted in Forum707. Please state the application you are running in.

Skip,
[sub]
To be safe on the [red]FOURTH[/red],
Don't take a [red]FIFTH[/red] on the [red]THIRD[/red]
Or you might not come [red]FORTH[/red] on the [red]FIFTH[/red]
[red][highlight blue]FORTH[/highlight][/red][white][highlight red]WITH[/highlight][/white] [/sub]

 

[bsl1973]

.exe

 

[BobRodes]

I don't see where you've declared the doc variable.