Solongipson
IS-IT--Management
I am trying to get a macro that my law firm uses to work with windows 7 and office 2007 from windows xp and office xp. Here is the problem; this macro does not work right because it can't write to the database that is stored in the ..\microsoft office\templates folder or to the root c: drive. I am having trouble getting the permissions to allow access so I decided to change the path in the macro to 'C:\Users\All Users\Templates' instead. This doesn't work and I get the following error:
Compile error in hidden module: frmBJLetter
I am very novice with macros and would like any help I cna get as to the cause of why this will not work. Following is the 'frmBJLetter' module from the error message. The only thing I changed in this macro was the path to where it is trying to write files. Thank you so much in advance
Private Sub chkDelivery_Change()
With frmBJLetter
If .chkDelivery.Value = False Then
.txtDelivery.Value = ""
.txtDelivery.Enabled = False
.txtDelivery.BackColor = &HE0E0E0
.lstDelivery.Enabled = False
.lstDelivery.BackColor = &HE0E0E0
Else
.txtDelivery.Value = .lstDelivery.Value
.txtDelivery.Enabled = True
.txtDelivery.BackColor = &HFFFFFF
.lstDelivery.Enabled = True
.lstDelivery.BackColor = &HFFFFFF
End If
End With
End Sub
Private Sub cmdAuthorDelete_Click()
Dim i As Integer
Dim lstcount As Integer
typdel = MsgBox("Are you sure you want to delete " & cmbAuthor.Text & " from your Author list?", vbYesNo + vbDefaultButton2, "Delete Author")
If typdel = vbYes Then
Open "c:\advautlst.ini" For Output As #1
lstcount = cmbAuthor.ListCount - 1
For i = 0 To lstcount
If i <> cmbAuthor.ListIndex Then
Write #1, cmbAuthor.List(i, 0), cmbAuthor.List(i, 1)
End If
Next i
Close #1
If lstcount = 0 Then
Dim mya(0, 0)
mya(0, 0) = "Click Find to add names"
cmbAuthor.List() = mya
cmbAuthor.Text = mya(0, 0)
Else
SetPersAuthorList
End If
End If
End Sub
Private Sub cmdAuthorFind_Click()
frmBJLetter.hide
frmAuthorFind.Show
End Sub
Private Sub cmdCancel_Click()
frmBJLetter.hide
ActiveDocument.Close
End
End Sub
Private Sub cmdOK_Click()
Dim seekautrec As Integer
Dim seektyprec As Integer
Dim checkaut As String
Dim checktyp As String
checkaut = cmbAuthor.Text
If checkaut = "Click Find to add names" Then
MsgBox ("You must select a valid Author! Click Find to pull from the master list.")
Exit Sub
End If
checktyp = cmbTypist.Text
If checktyp = "Click Find to add names" Then
MsgBox ("You must select a valid Typist! Click Find to pull from the master list.")
Exit Sub
End If
seekautrec = cmbAuthor.List(cmbAuthor.ListIndex, 1)
seektyprec = cmbTypist.List(cmbTypist.ListIndex, 1)
frmBJLetter.hide
Selection.GoTo What:=wdGoToBookmark, Name:="Date"
Selection.InsertDateTime DateTimeFormat:="MMMM d, yyyy", InsertAsField:=False
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
ActiveWindow.ActivePane.View.NextHeaderFooter
Selection.MoveDown Unit:=wdParagraph, Count:=3
'Selection.InsertDateTime DateTimeFormat:="MMMM d, yyyy", InsertAsField:=True
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
If chkRe.Value = True Then
frmRe.Show
Else
Selection.GoTo What:=wdGoToBookmark, Name:="Re"
Selection.Cut
End If
If chkEnc.Value = False Then
Selection.GoTo What:=wdGoToBookmark, Name:="Enc"
Selection.Cut
End If
txtSalutation = InputBox("Enter Salutation text:", "Advanced Legal Systems, Inc. Letterhead")
If chkCC.Value = True Then
frmCC.Show
Else
Selection.GoTo What:=wdGoToBookmark, Name:="CC"
Selection.Cut
End If
If chkBCC.Value = True Then
txtBCC = InputBox("Enter BCC: text:", "Advanced Legal Systems, Inc. Letterhead")
End If
With ActiveDocument
.Bookmarks("Salutation").Range.Text = txtSalutation
If Len(txtBCC) > 0 Then
.Bookmarks("bccText").Range.Text = txtBCC
Else
Selection.GoTo What:=wdGoToBookmark, Name:="BCC"
Selection.Cut
End If
If frmBJLetter.txtDelivery.Text <> "" Then
.Bookmarks("DeliveryText").Range.Text = frmBJLetter.txtDelivery.Text
Else
Selection.GoTo What:=wdGoToBookmark, Name:="Delivery"
Selection.Cut
End If
End With
Dim db As Database
Set db = OpenDatabase("c:\program files\microsoft office\templates\author.mdb", True True)
'Set db = OpenDatabase("c:\program files\microsoft office\templates\kfauthor.mdb")
'Set db = OpenDatabase("\\server\advlegal templates\kfauthor.mdb")
Set rs = db.OpenRecordset("tblAuthor", dbOpenTable)
With rs
.Index = "recordCounter"
.MoveFirst
.Seek "=", Val(seekautrec)
With ActiveDocument
mycheck = IsNull(rs.Fields("Closing").Value)
If mycheck = True Then
.Bookmarks("Closing").Range.Text = ""
Else
.Bookmarks("Closing").Range.Text = rs.Fields("Closing").Value
End If
mycheck = IsNull(rs.Fields("ClosingName").Value)
If mycheck = True Then
.Bookmarks("ClosingName").Range.Text = ""
Else
.Bookmarks("ClosingName").Range.Text = rs.Fields("ClosingName").Value
End If
mycheck = IsNull(rs.Fields("ClosingName").Value)
If mycheck = True Then
.Bookmarks("ClosingName2").Range.Text = ""
Else
.Bookmarks("ClosingName2").Range.Text = rs.Fields("ClosingName").Value
End If
mycheck = IsNull(rs.Fields("Initials").Value)
If mycheck = True Then
.Bookmarks("AutInitials").Range.Text = ""
Else
.Bookmarks("AutInitials").Range.Text = rs.Fields("Initials").Value
End If
mycheck = IsNull(rs.Fields("Title").Value)
Title = rs.Fields("Title").Value
admitin = InStr(Title, "Admitted in")
If rs.Fields("Title").Value <> "" Then
.Bookmarks("Title2").Range.Text = Chr(13) & rs.Fields("Title").Value
Else
End If
mycheck = IsNull(rs.Fields("HomeNo").Value)
If mycheck = True Then
.Bookmarks("HomeNo").Range.Text = ""
Else
.Bookmarks("HomeNo").Range.Text = rs.Fields("HomeNo").Value
' .Bookmarks("HomeNo2").Range.Text = rs.Fields("HomeNo").Value
End If
If rs.Fields("Faxno").Value <> "" Then
.Bookmarks("FaxNo").Range.Text = rs.Fields("FaxNo").Value
Else
End If
mycheck = IsNull(rs.Fields("FaxNo").Value)
End With
End With
With rs
.Index = "recordCounter"
.MoveFirst
.Seek "=", Val(seektyprec)
mycheck = IsNull(rs.Fields("Initials").Value)
If IsNull(mycheck) Then
ActiveDocument.Bookmarks("TypInitials").Range.Text = ""
Else
ActiveDocument.Bookmarks("TypInitials").Range.Text = .Fields("Initials").Value
End If
End With
rs.Close
db.Close
'If optAddrMultiple.Value = True Then
'letaddr = Application.GetAddress(Name:="", checknamesdialog:=true)
'letaddr = Application.GetAddress(Name:="", DisplaySelectDialog:=1)
'letaddress = letaddr
'again:
'addr = MsgBox("Select another address?", vbYesNo, "Multiple Addresses")
'If addr = vbYes Then
'letaddr = Application.GetAddress(Name:="", checknamesdialog:=True)
'letaddr = Application.GetAddress(Name:="", DisplaySelectDialog:=1)
'letaddress = letaddress & Chr(13) & Chr(13) & letaddr
'GoTo again
'End If
'ActiveDocument.Bookmarks("address").Range.Text = letaddress
'End If
'If optAddrManually.Value = True Then
'frmAddress.Show
'End If
'If optAddr.Value = True Then
'letaddress = Application.GetAddress(Name:="", checknamesdialog:=True)
' letaddress = Application.GetAddress(Name:="", DisplaySelectDialog:=1)
' ActiveDocument.Bookmarks("address").Range.Text = letaddress
'End If
'Selection.GoTo What:=wdGoToBookmark, Name:="Address"
'With ActiveDocument.Bookmarks
' .DefaultSorting = wdSortByName
' .ShowHidden = False
'End With
'Selection.EndKey Unit:=wdLine, Extend:=wdExtend
'Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'With ActiveDocument.Bookmarks
' .Add Range:=Selection.Range, Name:="FirstAddress"
' .DefaultSorting = wdSortByName
' .ShowHidden = False
'End With
'Selection.HomeKey Unit:=wdLine
Selection.GoTo What:=wdGoToBookmark, Name:="Text"
Selection.NextField.Select
frmBJLetter.hide
End Sub
Private Sub cmdSetDefault_Click()
Open "C:\Documents and Settings\All Users\Templates\advdeflist.ini" For Output As #1
Write #1, cmbAuthor.Text
Write #1, cmbTypist.Text
Write #1, chkDelivery.Value
Write #1, txtDelivery.Text
Write #1, lstDelivery.ListIndex
Write #1, optAddrManually.Value
Write #1, optAddrMultiple.Value
Write #1, chkRe.Value
Write #1, chkCC.Value
Write #1, chkBCC.Value
Write #1, chkEnc.Value
Write #1, chkDirectFax.Value
Write #1, chkAdmittedTo.Value
Close #1
MsgBox ("Defaults set!")
End Sub
Private Sub cmdTypistDelete_Click()
Dim i As Integer
Dim lstcount As Integer
typdel = MsgBox("Are you sure you want to delete " & cmbTypist.Text & " from your Typist list?", vbYesNo + vbDefaultButton2, "Delete Typist")
If typdel = vbYes Then
Open "C:\Documents and Settings\All Users\Templates\advtyplst.ini" For Output As #1
lstcount = cmbTypist.ListCount - 1
For i = 0 To lstcount
If i <> cmbTypist.ListIndex Then
Write #1, cmbTypist.List(i, 0), cmbTypist.List(i, 1)
End If
Next i
Close #1
If lstcount = 0 Then
Dim myt(0, 0)
myt(0, 0) = "Click Find to add names"
cmbTypist.List() = myt
cmbTypist.Text = myt(0, 0)
Else
SetPersTypistList
End If
End If
End Sub
Private Sub cmdTypistFind_Click()
frmBJLetter.hide
frmTypistFind.Show
End Sub
Private Sub lstDelivery_Change()
With frmBJLetter
If .chkDelivery.Value = True Then
.txtDelivery.Value = frmBJLetter.lstDelivery.Value
Else
.txtDelivery.Value = ""
End If
End With
End Sub
Sub SetPersAuthorList()
'Assigns the array to the listbox
Dim autarray()
Dim goaarray()
Dim noarray()
Dim i As Integer
Dim j As Integer
Open "C:\Documents and Settings\All Users\Templates\advautlst.ini" For Input As #1
i = 0
j = 0
While Not EOF(1)
ReDim Preserve autarray(i)
ReDim Preserve goaarray(i)
ReDim Preserve noarray(i)
Input #1, goaarray(i), noarray(i)
If goaarray(i) <> "Click Find to add names" Then
If goaarray(i) <> Chr(13) Or goaarray(i) <> "Null" Then
autarray(j) = goaarray(i)
noarray(j) = noarray(i)
j = j + 1
i = i + 1
Else
i = i + 1
End If
Else
i = i + 1
End If
Wend
Close 1
' If goaarray(0) = "Click Find to add names" Then
' If j = 0 Then
' autarray(0) = goaarray(0)
' End If
' End If
For j = 0 To UBound(autarray)
Debug.Print autarray(j)
Next j
Dim myarray()
ReDim myarray(UBound(autarray), 2)
For i = 0 To UBound(autarray)
myarray(i, 0) = autarray(i)
myarray(i, 1) = noarray(i)
Next i
cmbAuthor.List() = myarray
cmbAuthor.Text = myarray(0, 0)
End Sub
Sub SetPersTypistList()
Dim typarray()
Dim gotarray()
Dim notarray()
Dim k As Integer
Dim l As Integer
Open "C:\Documents and Settings\All Users\Templates\advtyplst.ini" For Input As #1
k = 0
l = 0
While Not EOF(1)
ReDim Preserve typarray(k)
ReDim Preserve gotarray(k)
ReDim Preserve notarray(k)
Input #1, gotarray(k), notarray(k)
If gotarray(k) <> "Click Find to add names" Then
If gotarray(k) <> "" Or gotarray(k) <> "Null" Then
typarray(l) = gotarray(k)
notarray(l) = notarray(k)
l = l + 1
k = k + 1
Else
k = k + 1
End If
Else
k = k + 1
End If
Wend
Close 1
If gotarray(0) = "Click Find to add names" Then
If l = 0 Then
typarray(0) = gotarray(0)
End If
End If
For l = 0 To UBound(typarray)
Debug.Print typarray(l)
Next l
Dim mytarray()
ReDim mytarray(UBound(typarray), 2)
For k = 0 To UBound(typarray)
mytarray(k, 0) = typarray(k)
mytarray(k, 1) = notarray(k)
Next k
cmbTypist.List() = mytarray
cmbTypist.Text = mytarray(0, 0)
End Sub
Sub SetPersTypistListx()
'
'Assigns the array to the listbox
'
Dim typarray()
Dim gotarray()
Dim k As Integer
Dim l As Integer
Open "C:\Documents and Settings\All Users\Templates\advtyplst.ini" For Input As #1
k = 0
l = 0
While Not EOF(1)
ReDim Preserve typarray(k)
ReDim Preserve gotarray(k)
Input #1, gotarray(k)
If gotarray(k) <> "Click Find to add names" Then
typarray(l) = gotarray(k)
l = l + 1
k = k + 1
Else
k = k + 1
End If
Wend
Close 1
If gotarray(0) = "Click Find to add names" Then
If l = 0 Then
typarray(0) = gotarray(0)
End If
End If
For l = 0 To UBound(typarray)
Debug.Print typarray(l)
Next l
cmbTypist.List() = typarray
cmbTypist.Text = typarray(0)
End Sub
Sub CheckAuthor()
Dim fred As String
Dim autfile
autfile = ""
autfile = Dir("C:\Documents and Settings\All Users\Templates\advautlst.ini")
If autfile = "advautlst.ini" Then
Open "C:\Documents and Settings\All Users\Templates\advautlst.ini" For Input As #1
fred = LOF(1)
If fred = 0 Then
GoTo fred
End If
Close #1
SetPersAuthorList
GoTo last
Else
GoTo fred1
End If
fred:
Close #1
fred1:
Dim aut(0, 0)
aut(0, 0) = "Click Find to add names"
cmbAuthor.List() = aut
cmbAuthor.Text = aut(0, 0)
' Open "c:\windows\kfautlst.ini" For Append As #1 ' Open file for output.
' Write #1, "Click Find to add names", "999"
' Close #1
' SetPersAuthorList
last:
End Sub
Sub CheckTypist()
Dim typfile
typfile = ""
typfile = Dir("C:\Documents and Settings\All Users\Templates\advtyplst.ini")
If typfile = "advtyplst.ini" Then
Open "C:\Documents and Settings\All Users\Templates\advtyplst.ini" For Input As #1
sam = LOF(1)
If sam = 0 Then
GoTo sam
End If
Close #1
SetPersTypistList
GoTo last1
Else
GoTo sam1
End If
sam:
Close #1
sam1:
Dim typ(0, 0)
typ(0, 0) = "Click Find to add names"
cmbTypist.List() = typ
cmbTypist.Text = typ(0, 0)
' Open "c:\windows\kftyplst.ini" For Append As #1 ' Open file for output.
' Write #1, "Click Find to add names", "999"
' Close #1
' SetPersTypistList
last1:
End Sub
Private Sub UserForm_Activate()
CheckAuthor
CheckTypist
End Sub
Private Sub UserForm_initialize()
CheckAuthor
CheckTypist
With frmBJLetter
.chkRe.Value = True
.chkDirectFax.Value = False
.chkDelivery.Value = False
.txtDelivery.Value = ""
.txtDelivery.Enabled = False
.txtDelivery.BackColor = &HE0E0E0
.lstDelivery.Enabled = False
.lstDelivery.BackColor = &HE0E0E0
.optAddr.Value = True
With .lstDelivery
.Clear
'.AddItem ("BY MESSENGER")
'.AddItem ("BY TELECOPY")
.AddItem ("BY FEDEX")
.AddItem ("BY FACSIMILE")
.AddItem ("BY FACSIMILE AND 1ST CLASS")
.AddItem ("BY ELECTRONIC MAIL")
.AddItem ("BY CERTIFIED MAIL - ## ")
.AddItem ("BY HAND DELIVERY")
.AddItem ("BY U.P.S.")
.Value = "BY FEDEX"
'.Value = "BY U.P.S."
End With
End With
'Set Defaults to screen
Dim chkfile As String
Dim prefaut As String
Dim preftyp As String
Dim chkdel As String
Dim txtdel As String
Dim lstdel As Integer
Dim chkman As String
Dim chkmult As String
Dim re As String
Dim cc As String
Dim bcc As String
Dim enc As String
Dim chkfax As String
Dim chkadto As String
chkfile = Dir("C:\Documents and Settings\All Users\Templates\advdeflist.ini")
If chkfile = "advdeflist.ini" Then
Open "c:\advdeflist.ini" For Input As #1
Input #1, prefaut
Input #1, preftyp
Input #1, chkdel
Input #1, txtdel
Input #1, lstdel
Input #1, chkman
Input #1, chkmult
Input #1, re
Input #1, cc
Input #1, bcc
Input #1, enc
Input #1, chkfax
Input #1, chkadto
Close 1
cmbAuthor.Text = prefaut
cmbTypist.Text = preftyp
chkDelivery.Value = chkdel
txtDelivery.Text = txtdel
lstDelivery.ListIndex = lstdel
optAddrManually.Value = chkman
optAddrMultiple.Value = chkmult
chkRe.Value = re
chkCC.Value = cc
chkBCC.Value = bcc
chkEnc.Value = enc
chkDirectFax.Value = chkfax
chkAdmittedTo.Value = chkadto
End If
End Sub
Compile error in hidden module: frmBJLetter
I am very novice with macros and would like any help I cna get as to the cause of why this will not work. Following is the 'frmBJLetter' module from the error message. The only thing I changed in this macro was the path to where it is trying to write files. Thank you so much in advance
Private Sub chkDelivery_Change()
With frmBJLetter
If .chkDelivery.Value = False Then
.txtDelivery.Value = ""
.txtDelivery.Enabled = False
.txtDelivery.BackColor = &HE0E0E0
.lstDelivery.Enabled = False
.lstDelivery.BackColor = &HE0E0E0
Else
.txtDelivery.Value = .lstDelivery.Value
.txtDelivery.Enabled = True
.txtDelivery.BackColor = &HFFFFFF
.lstDelivery.Enabled = True
.lstDelivery.BackColor = &HFFFFFF
End If
End With
End Sub
Private Sub cmdAuthorDelete_Click()
Dim i As Integer
Dim lstcount As Integer
typdel = MsgBox("Are you sure you want to delete " & cmbAuthor.Text & " from your Author list?", vbYesNo + vbDefaultButton2, "Delete Author")
If typdel = vbYes Then
Open "c:\advautlst.ini" For Output As #1
lstcount = cmbAuthor.ListCount - 1
For i = 0 To lstcount
If i <> cmbAuthor.ListIndex Then
Write #1, cmbAuthor.List(i, 0), cmbAuthor.List(i, 1)
End If
Next i
Close #1
If lstcount = 0 Then
Dim mya(0, 0)
mya(0, 0) = "Click Find to add names"
cmbAuthor.List() = mya
cmbAuthor.Text = mya(0, 0)
Else
SetPersAuthorList
End If
End If
End Sub
Private Sub cmdAuthorFind_Click()
frmBJLetter.hide
frmAuthorFind.Show
End Sub
Private Sub cmdCancel_Click()
frmBJLetter.hide
ActiveDocument.Close
End
End Sub
Private Sub cmdOK_Click()
Dim seekautrec As Integer
Dim seektyprec As Integer
Dim checkaut As String
Dim checktyp As String
checkaut = cmbAuthor.Text
If checkaut = "Click Find to add names" Then
MsgBox ("You must select a valid Author! Click Find to pull from the master list.")
Exit Sub
End If
checktyp = cmbTypist.Text
If checktyp = "Click Find to add names" Then
MsgBox ("You must select a valid Typist! Click Find to pull from the master list.")
Exit Sub
End If
seekautrec = cmbAuthor.List(cmbAuthor.ListIndex, 1)
seektyprec = cmbTypist.List(cmbTypist.ListIndex, 1)
frmBJLetter.hide
Selection.GoTo What:=wdGoToBookmark, Name:="Date"
Selection.InsertDateTime DateTimeFormat:="MMMM d, yyyy", InsertAsField:=False
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
ActiveWindow.ActivePane.View.NextHeaderFooter
Selection.MoveDown Unit:=wdParagraph, Count:=3
'Selection.InsertDateTime DateTimeFormat:="MMMM d, yyyy", InsertAsField:=True
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
If chkRe.Value = True Then
frmRe.Show
Else
Selection.GoTo What:=wdGoToBookmark, Name:="Re"
Selection.Cut
End If
If chkEnc.Value = False Then
Selection.GoTo What:=wdGoToBookmark, Name:="Enc"
Selection.Cut
End If
txtSalutation = InputBox("Enter Salutation text:", "Advanced Legal Systems, Inc. Letterhead")
If chkCC.Value = True Then
frmCC.Show
Else
Selection.GoTo What:=wdGoToBookmark, Name:="CC"
Selection.Cut
End If
If chkBCC.Value = True Then
txtBCC = InputBox("Enter BCC: text:", "Advanced Legal Systems, Inc. Letterhead")
End If
With ActiveDocument
.Bookmarks("Salutation").Range.Text = txtSalutation
If Len(txtBCC) > 0 Then
.Bookmarks("bccText").Range.Text = txtBCC
Else
Selection.GoTo What:=wdGoToBookmark, Name:="BCC"
Selection.Cut
End If
If frmBJLetter.txtDelivery.Text <> "" Then
.Bookmarks("DeliveryText").Range.Text = frmBJLetter.txtDelivery.Text
Else
Selection.GoTo What:=wdGoToBookmark, Name:="Delivery"
Selection.Cut
End If
End With
Dim db As Database
Set db = OpenDatabase("c:\program files\microsoft office\templates\author.mdb", True True)
'Set db = OpenDatabase("c:\program files\microsoft office\templates\kfauthor.mdb")
'Set db = OpenDatabase("\\server\advlegal templates\kfauthor.mdb")
Set rs = db.OpenRecordset("tblAuthor", dbOpenTable)
With rs
.Index = "recordCounter"
.MoveFirst
.Seek "=", Val(seekautrec)
With ActiveDocument
mycheck = IsNull(rs.Fields("Closing").Value)
If mycheck = True Then
.Bookmarks("Closing").Range.Text = ""
Else
.Bookmarks("Closing").Range.Text = rs.Fields("Closing").Value
End If
mycheck = IsNull(rs.Fields("ClosingName").Value)
If mycheck = True Then
.Bookmarks("ClosingName").Range.Text = ""
Else
.Bookmarks("ClosingName").Range.Text = rs.Fields("ClosingName").Value
End If
mycheck = IsNull(rs.Fields("ClosingName").Value)
If mycheck = True Then
.Bookmarks("ClosingName2").Range.Text = ""
Else
.Bookmarks("ClosingName2").Range.Text = rs.Fields("ClosingName").Value
End If
mycheck = IsNull(rs.Fields("Initials").Value)
If mycheck = True Then
.Bookmarks("AutInitials").Range.Text = ""
Else
.Bookmarks("AutInitials").Range.Text = rs.Fields("Initials").Value
End If
mycheck = IsNull(rs.Fields("Title").Value)
Title = rs.Fields("Title").Value
admitin = InStr(Title, "Admitted in")
If rs.Fields("Title").Value <> "" Then
.Bookmarks("Title2").Range.Text = Chr(13) & rs.Fields("Title").Value
Else
End If
mycheck = IsNull(rs.Fields("HomeNo").Value)
If mycheck = True Then
.Bookmarks("HomeNo").Range.Text = ""
Else
.Bookmarks("HomeNo").Range.Text = rs.Fields("HomeNo").Value
' .Bookmarks("HomeNo2").Range.Text = rs.Fields("HomeNo").Value
End If
If rs.Fields("Faxno").Value <> "" Then
.Bookmarks("FaxNo").Range.Text = rs.Fields("FaxNo").Value
Else
End If
mycheck = IsNull(rs.Fields("FaxNo").Value)
End With
End With
With rs
.Index = "recordCounter"
.MoveFirst
.Seek "=", Val(seektyprec)
mycheck = IsNull(rs.Fields("Initials").Value)
If IsNull(mycheck) Then
ActiveDocument.Bookmarks("TypInitials").Range.Text = ""
Else
ActiveDocument.Bookmarks("TypInitials").Range.Text = .Fields("Initials").Value
End If
End With
rs.Close
db.Close
'If optAddrMultiple.Value = True Then
'letaddr = Application.GetAddress(Name:="", checknamesdialog:=true)
'letaddr = Application.GetAddress(Name:="", DisplaySelectDialog:=1)
'letaddress = letaddr
'again:
'addr = MsgBox("Select another address?", vbYesNo, "Multiple Addresses")
'If addr = vbYes Then
'letaddr = Application.GetAddress(Name:="", checknamesdialog:=True)
'letaddr = Application.GetAddress(Name:="", DisplaySelectDialog:=1)
'letaddress = letaddress & Chr(13) & Chr(13) & letaddr
'GoTo again
'End If
'ActiveDocument.Bookmarks("address").Range.Text = letaddress
'End If
'If optAddrManually.Value = True Then
'frmAddress.Show
'End If
'If optAddr.Value = True Then
'letaddress = Application.GetAddress(Name:="", checknamesdialog:=True)
' letaddress = Application.GetAddress(Name:="", DisplaySelectDialog:=1)
' ActiveDocument.Bookmarks("address").Range.Text = letaddress
'End If
'Selection.GoTo What:=wdGoToBookmark, Name:="Address"
'With ActiveDocument.Bookmarks
' .DefaultSorting = wdSortByName
' .ShowHidden = False
'End With
'Selection.EndKey Unit:=wdLine, Extend:=wdExtend
'Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'With ActiveDocument.Bookmarks
' .Add Range:=Selection.Range, Name:="FirstAddress"
' .DefaultSorting = wdSortByName
' .ShowHidden = False
'End With
'Selection.HomeKey Unit:=wdLine
Selection.GoTo What:=wdGoToBookmark, Name:="Text"
Selection.NextField.Select
frmBJLetter.hide
End Sub
Private Sub cmdSetDefault_Click()
Open "C:\Documents and Settings\All Users\Templates\advdeflist.ini" For Output As #1
Write #1, cmbAuthor.Text
Write #1, cmbTypist.Text
Write #1, chkDelivery.Value
Write #1, txtDelivery.Text
Write #1, lstDelivery.ListIndex
Write #1, optAddrManually.Value
Write #1, optAddrMultiple.Value
Write #1, chkRe.Value
Write #1, chkCC.Value
Write #1, chkBCC.Value
Write #1, chkEnc.Value
Write #1, chkDirectFax.Value
Write #1, chkAdmittedTo.Value
Close #1
MsgBox ("Defaults set!")
End Sub
Private Sub cmdTypistDelete_Click()
Dim i As Integer
Dim lstcount As Integer
typdel = MsgBox("Are you sure you want to delete " & cmbTypist.Text & " from your Typist list?", vbYesNo + vbDefaultButton2, "Delete Typist")
If typdel = vbYes Then
Open "C:\Documents and Settings\All Users\Templates\advtyplst.ini" For Output As #1
lstcount = cmbTypist.ListCount - 1
For i = 0 To lstcount
If i <> cmbTypist.ListIndex Then
Write #1, cmbTypist.List(i, 0), cmbTypist.List(i, 1)
End If
Next i
Close #1
If lstcount = 0 Then
Dim myt(0, 0)
myt(0, 0) = "Click Find to add names"
cmbTypist.List() = myt
cmbTypist.Text = myt(0, 0)
Else
SetPersTypistList
End If
End If
End Sub
Private Sub cmdTypistFind_Click()
frmBJLetter.hide
frmTypistFind.Show
End Sub
Private Sub lstDelivery_Change()
With frmBJLetter
If .chkDelivery.Value = True Then
.txtDelivery.Value = frmBJLetter.lstDelivery.Value
Else
.txtDelivery.Value = ""
End If
End With
End Sub
Sub SetPersAuthorList()
'Assigns the array to the listbox
Dim autarray()
Dim goaarray()
Dim noarray()
Dim i As Integer
Dim j As Integer
Open "C:\Documents and Settings\All Users\Templates\advautlst.ini" For Input As #1
i = 0
j = 0
While Not EOF(1)
ReDim Preserve autarray(i)
ReDim Preserve goaarray(i)
ReDim Preserve noarray(i)
Input #1, goaarray(i), noarray(i)
If goaarray(i) <> "Click Find to add names" Then
If goaarray(i) <> Chr(13) Or goaarray(i) <> "Null" Then
autarray(j) = goaarray(i)
noarray(j) = noarray(i)
j = j + 1
i = i + 1
Else
i = i + 1
End If
Else
i = i + 1
End If
Wend
Close 1
' If goaarray(0) = "Click Find to add names" Then
' If j = 0 Then
' autarray(0) = goaarray(0)
' End If
' End If
For j = 0 To UBound(autarray)
Debug.Print autarray(j)
Next j
Dim myarray()
ReDim myarray(UBound(autarray), 2)
For i = 0 To UBound(autarray)
myarray(i, 0) = autarray(i)
myarray(i, 1) = noarray(i)
Next i
cmbAuthor.List() = myarray
cmbAuthor.Text = myarray(0, 0)
End Sub
Sub SetPersTypistList()
Dim typarray()
Dim gotarray()
Dim notarray()
Dim k As Integer
Dim l As Integer
Open "C:\Documents and Settings\All Users\Templates\advtyplst.ini" For Input As #1
k = 0
l = 0
While Not EOF(1)
ReDim Preserve typarray(k)
ReDim Preserve gotarray(k)
ReDim Preserve notarray(k)
Input #1, gotarray(k), notarray(k)
If gotarray(k) <> "Click Find to add names" Then
If gotarray(k) <> "" Or gotarray(k) <> "Null" Then
typarray(l) = gotarray(k)
notarray(l) = notarray(k)
l = l + 1
k = k + 1
Else
k = k + 1
End If
Else
k = k + 1
End If
Wend
Close 1
If gotarray(0) = "Click Find to add names" Then
If l = 0 Then
typarray(0) = gotarray(0)
End If
End If
For l = 0 To UBound(typarray)
Debug.Print typarray(l)
Next l
Dim mytarray()
ReDim mytarray(UBound(typarray), 2)
For k = 0 To UBound(typarray)
mytarray(k, 0) = typarray(k)
mytarray(k, 1) = notarray(k)
Next k
cmbTypist.List() = mytarray
cmbTypist.Text = mytarray(0, 0)
End Sub
Sub SetPersTypistListx()
'
'Assigns the array to the listbox
'
Dim typarray()
Dim gotarray()
Dim k As Integer
Dim l As Integer
Open "C:\Documents and Settings\All Users\Templates\advtyplst.ini" For Input As #1
k = 0
l = 0
While Not EOF(1)
ReDim Preserve typarray(k)
ReDim Preserve gotarray(k)
Input #1, gotarray(k)
If gotarray(k) <> "Click Find to add names" Then
typarray(l) = gotarray(k)
l = l + 1
k = k + 1
Else
k = k + 1
End If
Wend
Close 1
If gotarray(0) = "Click Find to add names" Then
If l = 0 Then
typarray(0) = gotarray(0)
End If
End If
For l = 0 To UBound(typarray)
Debug.Print typarray(l)
Next l
cmbTypist.List() = typarray
cmbTypist.Text = typarray(0)
End Sub
Sub CheckAuthor()
Dim fred As String
Dim autfile
autfile = ""
autfile = Dir("C:\Documents and Settings\All Users\Templates\advautlst.ini")
If autfile = "advautlst.ini" Then
Open "C:\Documents and Settings\All Users\Templates\advautlst.ini" For Input As #1
fred = LOF(1)
If fred = 0 Then
GoTo fred
End If
Close #1
SetPersAuthorList
GoTo last
Else
GoTo fred1
End If
fred:
Close #1
fred1:
Dim aut(0, 0)
aut(0, 0) = "Click Find to add names"
cmbAuthor.List() = aut
cmbAuthor.Text = aut(0, 0)
' Open "c:\windows\kfautlst.ini" For Append As #1 ' Open file for output.
' Write #1, "Click Find to add names", "999"
' Close #1
' SetPersAuthorList
last:
End Sub
Sub CheckTypist()
Dim typfile
typfile = ""
typfile = Dir("C:\Documents and Settings\All Users\Templates\advtyplst.ini")
If typfile = "advtyplst.ini" Then
Open "C:\Documents and Settings\All Users\Templates\advtyplst.ini" For Input As #1
sam = LOF(1)
If sam = 0 Then
GoTo sam
End If
Close #1
SetPersTypistList
GoTo last1
Else
GoTo sam1
End If
sam:
Close #1
sam1:
Dim typ(0, 0)
typ(0, 0) = "Click Find to add names"
cmbTypist.List() = typ
cmbTypist.Text = typ(0, 0)
' Open "c:\windows\kftyplst.ini" For Append As #1 ' Open file for output.
' Write #1, "Click Find to add names", "999"
' Close #1
' SetPersTypistList
last1:
End Sub
Private Sub UserForm_Activate()
CheckAuthor
CheckTypist
End Sub
Private Sub UserForm_initialize()
CheckAuthor
CheckTypist
With frmBJLetter
.chkRe.Value = True
.chkDirectFax.Value = False
.chkDelivery.Value = False
.txtDelivery.Value = ""
.txtDelivery.Enabled = False
.txtDelivery.BackColor = &HE0E0E0
.lstDelivery.Enabled = False
.lstDelivery.BackColor = &HE0E0E0
.optAddr.Value = True
With .lstDelivery
.Clear
'.AddItem ("BY MESSENGER")
'.AddItem ("BY TELECOPY")
.AddItem ("BY FEDEX")
.AddItem ("BY FACSIMILE")
.AddItem ("BY FACSIMILE AND 1ST CLASS")
.AddItem ("BY ELECTRONIC MAIL")
.AddItem ("BY CERTIFIED MAIL - ## ")
.AddItem ("BY HAND DELIVERY")
.AddItem ("BY U.P.S.")
.Value = "BY FEDEX"
'.Value = "BY U.P.S."
End With
End With
'Set Defaults to screen
Dim chkfile As String
Dim prefaut As String
Dim preftyp As String
Dim chkdel As String
Dim txtdel As String
Dim lstdel As Integer
Dim chkman As String
Dim chkmult As String
Dim re As String
Dim cc As String
Dim bcc As String
Dim enc As String
Dim chkfax As String
Dim chkadto As String
chkfile = Dir("C:\Documents and Settings\All Users\Templates\advdeflist.ini")
If chkfile = "advdeflist.ini" Then
Open "c:\advdeflist.ini" For Input As #1
Input #1, prefaut
Input #1, preftyp
Input #1, chkdel
Input #1, txtdel
Input #1, lstdel
Input #1, chkman
Input #1, chkmult
Input #1, re
Input #1, cc
Input #1, bcc
Input #1, enc
Input #1, chkfax
Input #1, chkadto
Close 1
cmbAuthor.Text = prefaut
cmbTypist.Text = preftyp
chkDelivery.Value = chkdel
txtDelivery.Text = txtdel
lstDelivery.ListIndex = lstdel
optAddrManually.Value = chkman
optAddrMultiple.Value = chkmult
chkRe.Value = re
chkCC.Value = cc
chkBCC.Value = bcc
chkEnc.Value = enc
chkDirectFax.Value = chkfax
chkAdmittedTo.Value = chkadto
End If
End Sub
