R
Ravi
Hi Everybody,
I am trying to export a form (all the data in the form) to a word
template. Now once my clients go in to my database and create a new
record they can export this record (form) onto a word document. But
then I am trying to make it such that if they go back in to my
database and update that specific record and try to export it to word,
then it should be bring the old saved file (word document) and clear
all the previous bookmarks and publish the word document with new data
(the updated data).
Now I am able to export the record to a word document (if the user is
creating a record for the first time then its working fine). Even when
a user try's to export it again, my code is able to find the old
document and bring it up but the problem lies in clearing the
bookmarks. Instead of clearing the old bookmarks, it just adds (OR
CONCATENATES I should say) the old data in the bookmark with the new
bookmark.
Is there anyway I can clear the contents of the old bookmark before
publishing the old word document.
Any kind of help will be really appreciated.
Below is the code that I am using in order to export to Word Document:
Private Sub Command137_Click()
On Error GoTo Err_Command137_Click
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
Dim WordTemplate As String
'WordTemplate = "C:\WINNT\Profiles\c62dr60\desktop\Stemp.dot"
Dim FoundFile As Boolean
'WordTemplate = "G:\RModi\updates\Stemp.dot"
'Functional Area Block
'********************************************************************************
'********************************************************************************
'CHECKING FOR AN EXISTING DOCUMENT
Dim CurWord As String
Dim ProjectNum As String
ProjectNum = Me.ReferenceNumberTxt
CurWord = "G:\RModi\updates\" & ProjectNum & ".doc"
With Application.FileSearch
.LookIn = "G:\RModi\updates\"
'.LookIn = "C:\WINNT\Profiles\c62dr60\desktop\"
.FileName = ProjectNum & ".doc"
If .Execute(SortBy:=msoSortbyFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
WordTemplate = "G:\RModi\updates\" & ProjectNum & ".doc"
'WordTemplate = "C:\WINNT\Profiles\c62dr60\desktop\Stemp.dot"
FoundFile = True
Else
'WordTemplate = "C:\WINNT\Profiles\c62dr60\desktop\Stemp.dot"
WordTemplate = "G:\RModi\updates\sow.dot"
MsgBox "There were no files found."
FoundFile = False
End If
End With
Dim FunctionalAreaNum As Integer
Dim strFunctional As String
'Testing Considerations Block
Dim TestingNum As Integer
Dim strTestingNone As String
Dim strMHS As String
Dim strQIPS As String
Dim strGeoAccess As String
Dim strCapitation As String
Dim strother As String
Dim strTestingAll As String
'Considerations Block
Dim strConsAll As String
Dim strConsNone As String
Dim strConsMHS As String
Dim strConsHipaa As String
Dim strConsOptimed As String
Dim strConsCorp As String
Dim strConsProv As String
Dim strConsSliq As String
Dim strConsEcom As String
Dim strConsPlanmate As String
Dim ConsidOther As String
Dim DB As Database
Set DB = CurrentDb
Dim Quote As String
Quote = Chr$(34)
'Implementation CheckList Block
Dim strImplAll As String
Dim strProgName As String
Dim strProj As String
Dim ImplOther As String
Dim CreatedBy As Recordset
Set CreatedBy = DB.OpenRecordset("SELECT
SOWCreatedByTable.CreatedBy From SOWCreatedByTable Where
SOWCreatedByTable.[Project#] = " & Quote & Me.ReferenceNumberTxt &
Quote & " AND SOWCreatedByTable.[Version] = " & Me.VersionNumberTxt &
";")
Dim strCreatedBy As String
Dim Bookmark As Object
If FoundFile = True Then
'Call ClearAllBookmarks
'*****************TESTING****************************
'With objWord
'.Documents.Open (WordTemplate)
'Set Bookmark =
objWord.ActiveDocument.Bookmarks("RefNumber")
'Bookmark.Clear
'End With
'*****************TESTING FINISHED********************
With CreatedBy
Do While Not .EOF
If strCreatedBy = "" Then
strCreatedBy = CreatedBy.Fields(0)
ElseIf strCreatedBy <> "" Then
strCreatedBy = strCreatedBy & vbCrLf & _
CreatedBy.Fields(0)
End If
.MoveNext
Loop
End With
With objWord
.Visible = True
.Documents.Open (WordTemplate)
.ActiveDocument.Bookmarks("RefNumber").Range.Select
.Selection.text = (CStr(Me.ReferenceNumberTxt &
vbNullString))
.ActiveDocument.Bookmarks("Version").Select
.Selection.text = (CStr(Me.VersionNumberTxt &
vbNullString))
.ActiveDocument.Bookmarks("Activity").Select
.Selection.text = (CStr(Me.Activity & vbNullString))
.ActiveDocument.Bookmarks("Assumptions").Select
.Selection.text = (CStr(Me.Assumptions &
vbNullString))
.ActiveDocument.Bookmarks("CostDescription").Select
.Selection.text = (CStr(Me.CostDescription &
vbNullString))
.ActiveDocument.Bookmarks("CreatedBy").Select
.Selection.text = (CStr(strCreatedBy & vbNullString))
.ActiveDocument.Bookmarks("CreationDate").Select
.Selection.text = (CStr(Me.CreateDate & vbNullString))
.ActiveDocument.Bookmarks("EndResearch").Select
.Selection.text = (CStr(Me.EndResearch &
vbNullString))
.ActiveDocument.Bookmarks("ISLead").Select
.Selection.text = (CStr(Me.ISLeadCmb & vbNullString))
.ActiveDocument.Bookmarks("RequestName").Select
.Selection.text = (CStr(Me.RequestNameTxt &
vbNullString))
.ActiveDocument.Bookmarks("RevisionDate").Select
.Selection.text = (CStr(Me.RevisionDate &
vbNullString))
.ActiveDocument.Bookmarks("Scope").Select
.Selection.text = (CStr(Me.ScopeTxt & vbNullString))
.ActiveDocument.Bookmarks("ServiceRequestDate").Select
.Selection.text = (CStr(Me.ServiceRequestDateTxt &
vbNullString))
.ActiveDocument.Bookmarks("StartActive").Select
.Selection.text = (CStr(Me.StartActive &
vbNullString))
.ActiveDocument.Bookmarks("StartResearch").Select
.Selection.text = (CStr(Me.StartResearch &
vbNullString))
.ActiveDocument.Bookmarks("SystemComplete").Select
.Selection.text = (CStr(Me.SystemTestComplete &
vbNullString))
FunctionalAreaNum = FunctionalAreaTxt
If FunctionalAreaNum = 1 Then
strFunctional = "Professional Only"
ElseIf FunctionalAreaNum = 2 Then
strFunctional = "Institutional Only"
ElseIf FunctionalAreaNum = 3 Then
strFunctional = "Professional and Institutional"
End If
.ActiveDocument.Bookmarks("FunctionalArea").Select
.Selection.text = (CStr(strFunctional & vbNullString))
'******************Testing Considerations Block
*******************************
If Me!TestingConsNone.Value = True Then
strTestingNone = "None" & vbCrLf
ElseIf Me!TestingConsNone.Value = False Then
strTestingNone = ""
End If
If Me!TestingConsMHS.Value = True Then
strMHS = "MHS" & vbCrLf
ElseIf Me!TestingConsMHS.Value = False Then
strMHS = ""
End If
If Me!TestingConsQIPS.Value = True Then
strQIPS = "QIPS" & vbCrLf
ElseIf Me!TestingConsQIPS.Value = False Then
strQIPS = ""
End If
If Me!TestingConsCapitation.Value = True Then
strCapitation = "Capitation" & vbCrLf
ElseIf Me!TestingConsCapitation.Value = False Then
strCapitation = ""
End If
If Me!TestingConsGEOAccess.Value = True Then
strGeoAccess = "GeoAccess" & vbCrLf
Else
strGeoAccess = ""
End If
If Me!TestingOtherChk.Value = True Then
strother = "OTHER: " & Me!TestingConsiderationsOther
strTestingAll = strTestingNone & strMHS & strQIPS &
strCapitation & strGeoAccess & strother
ElseIf Me!TestingOtherChk.Value = False Then
strother = ""
strTestingAll = strTestingNone & strMHS & strQIPS &
strCapitation & strGeoAccess
End If
.ActiveDocument.Bookmarks("TestingCons").Select
.Selection.text = (CStr(strTestingAll & vbNullString))
'******************Considerations Block
*******************************
If Me!ConsiderationsNone.Value = True Then
strConsNone = "None" & vbCrLf
ElseIf Me!ConsiderationsNone.Value = False Then
strConsNone = ""
End If
If Me!ConsiderationsMHS.Value = True Then
strConsMHS = "MHS Interface" & vbCrLf
ElseIf Me!ConsiderationsMHS.Value = False Then
strConsMHS = ""
End If
If Me!ConsiderationsOptimed.Value = True Then
strConsOptimed = "Optimed" & vbCrLf
ElseIf Me!ConsiderationsOptimed.Value = False Then
strConsOptimed = ""
End If
If Me!ConsiderationsCorpDataWrhse.Value = True Then
strConsCorp = "Corporate Data Warehouse" & vbCrLf
ElseIf Me!ConsiderationsCorpDataWrhse.Value = False
Then
strConsCorp = ""
End If
If Me!ConsiderationsProviderDir.Value = True Then
strConsProv = "Provider Directory" & vbCrLf
Else
strConsProv = ""
End If
If Me!ConsiderationsSLIQ.Value = True Then
strConsSliq = "SLIQ" & vbCrLf
Else
strConsSliq = ""
End If
If Me!ConsiderationsHIPAA.Value = True Then
strConsHipaa = "HIPAA" & vbCrLf
Else
strConsHipaa = ""
End If
If Me!ConsiderationsECommerce.Value = True Then
strConsEcom = "ECommerce" & vbCrLf
Else
strConsEcom = ""
End If
If Me!ConsiderationsPlanmate.Value = True Then
strConsPlanmate = "Planmate" & vbCrLf
Else
strConsPlanmate = ""
End If
If Me!ConsiderationsOtherChk.Value = True Then
ConsidOther = "OTHER: " & Me!ConsiderationsOther
strConsAll = strConsNone & strConsMHS & strConsOptimed
& strConsCorp & strConsProv & strConsSliq & strConsEcom &
strConsPlanmate & ConsidOther
ElseIf Me!ConsiderationsOtherChk.Value = False Then
ConsidOther = ""
strConsAll = strConsNone & strConsMHS & strConsOptimed
& strConsCorp & strConsProv & strConsSliq & strConsEcom &
strConsPlanmate & ConsidOther
End If
.ActiveDocument.Bookmarks("Considerations").Select
.Selection.text = (CStr(strConsAll & vbNullString))
'******************Implementation Block
*******************************
If Me!ProgramNameChk.Value = True Then
strProgName = "Program: " &
Me!ImplChecklistProgramName & vbCrLf
Else
strProgName = ""
End If
If Me!ImplChecklistProjanChk.Value = True Then
strProj = "Program Names Added to Projan" & vbCrLf
Else
strProj = ""
End If
If Me!ImplOtherChk.Value = True Then
ImplOther = "Other: " & Me!ImplChecklistOther & vbCrLf
Else
ImplOther = ""
End If
strImplAll = strProgName & strProj & ImplOther
.ActiveDocument.Bookmarks("Implementation").Select
.Selection.text = (CStr(strImplAll & vbNullString))
End With
Else
'Perform the samething as above.
End If
'End if
Exit_Command137_Click:
Exit Sub
Err_Command137_Click:
MsgBox Err.Description
Resume Exit_Command137_Click
End Sub
Thanks in advance for your help.
R143r
I am trying to export a form (all the data in the form) to a word
template. Now once my clients go in to my database and create a new
record they can export this record (form) onto a word document. But
then I am trying to make it such that if they go back in to my
database and update that specific record and try to export it to word,
then it should be bring the old saved file (word document) and clear
all the previous bookmarks and publish the word document with new data
(the updated data).
Now I am able to export the record to a word document (if the user is
creating a record for the first time then its working fine). Even when
a user try's to export it again, my code is able to find the old
document and bring it up but the problem lies in clearing the
bookmarks. Instead of clearing the old bookmarks, it just adds (OR
CONCATENATES I should say) the old data in the bookmark with the new
bookmark.
Is there anyway I can clear the contents of the old bookmark before
publishing the old word document.
Any kind of help will be really appreciated.
Below is the code that I am using in order to export to Word Document:
Private Sub Command137_Click()
On Error GoTo Err_Command137_Click
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
Dim WordTemplate As String
'WordTemplate = "C:\WINNT\Profiles\c62dr60\desktop\Stemp.dot"
Dim FoundFile As Boolean
'WordTemplate = "G:\RModi\updates\Stemp.dot"
'Functional Area Block
'********************************************************************************
'********************************************************************************
'CHECKING FOR AN EXISTING DOCUMENT
Dim CurWord As String
Dim ProjectNum As String
ProjectNum = Me.ReferenceNumberTxt
CurWord = "G:\RModi\updates\" & ProjectNum & ".doc"
With Application.FileSearch
.LookIn = "G:\RModi\updates\"
'.LookIn = "C:\WINNT\Profiles\c62dr60\desktop\"
.FileName = ProjectNum & ".doc"
If .Execute(SortBy:=msoSortbyFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
WordTemplate = "G:\RModi\updates\" & ProjectNum & ".doc"
'WordTemplate = "C:\WINNT\Profiles\c62dr60\desktop\Stemp.dot"
FoundFile = True
Else
'WordTemplate = "C:\WINNT\Profiles\c62dr60\desktop\Stemp.dot"
WordTemplate = "G:\RModi\updates\sow.dot"
MsgBox "There were no files found."
FoundFile = False
End If
End With
Dim FunctionalAreaNum As Integer
Dim strFunctional As String
'Testing Considerations Block
Dim TestingNum As Integer
Dim strTestingNone As String
Dim strMHS As String
Dim strQIPS As String
Dim strGeoAccess As String
Dim strCapitation As String
Dim strother As String
Dim strTestingAll As String
'Considerations Block
Dim strConsAll As String
Dim strConsNone As String
Dim strConsMHS As String
Dim strConsHipaa As String
Dim strConsOptimed As String
Dim strConsCorp As String
Dim strConsProv As String
Dim strConsSliq As String
Dim strConsEcom As String
Dim strConsPlanmate As String
Dim ConsidOther As String
Dim DB As Database
Set DB = CurrentDb
Dim Quote As String
Quote = Chr$(34)
'Implementation CheckList Block
Dim strImplAll As String
Dim strProgName As String
Dim strProj As String
Dim ImplOther As String
Dim CreatedBy As Recordset
Set CreatedBy = DB.OpenRecordset("SELECT
SOWCreatedByTable.CreatedBy From SOWCreatedByTable Where
SOWCreatedByTable.[Project#] = " & Quote & Me.ReferenceNumberTxt &
Quote & " AND SOWCreatedByTable.[Version] = " & Me.VersionNumberTxt &
";")
Dim strCreatedBy As String
Dim Bookmark As Object
If FoundFile = True Then
'Call ClearAllBookmarks
'*****************TESTING****************************
'With objWord
'.Documents.Open (WordTemplate)
'Set Bookmark =
objWord.ActiveDocument.Bookmarks("RefNumber")
'Bookmark.Clear
'End With
'*****************TESTING FINISHED********************
With CreatedBy
Do While Not .EOF
If strCreatedBy = "" Then
strCreatedBy = CreatedBy.Fields(0)
ElseIf strCreatedBy <> "" Then
strCreatedBy = strCreatedBy & vbCrLf & _
CreatedBy.Fields(0)
End If
.MoveNext
Loop
End With
With objWord
.Visible = True
.Documents.Open (WordTemplate)
.ActiveDocument.Bookmarks("RefNumber").Range.Select
.Selection.text = (CStr(Me.ReferenceNumberTxt &
vbNullString))
.ActiveDocument.Bookmarks("Version").Select
.Selection.text = (CStr(Me.VersionNumberTxt &
vbNullString))
.ActiveDocument.Bookmarks("Activity").Select
.Selection.text = (CStr(Me.Activity & vbNullString))
.ActiveDocument.Bookmarks("Assumptions").Select
.Selection.text = (CStr(Me.Assumptions &
vbNullString))
.ActiveDocument.Bookmarks("CostDescription").Select
.Selection.text = (CStr(Me.CostDescription &
vbNullString))
.ActiveDocument.Bookmarks("CreatedBy").Select
.Selection.text = (CStr(strCreatedBy & vbNullString))
.ActiveDocument.Bookmarks("CreationDate").Select
.Selection.text = (CStr(Me.CreateDate & vbNullString))
.ActiveDocument.Bookmarks("EndResearch").Select
.Selection.text = (CStr(Me.EndResearch &
vbNullString))
.ActiveDocument.Bookmarks("ISLead").Select
.Selection.text = (CStr(Me.ISLeadCmb & vbNullString))
.ActiveDocument.Bookmarks("RequestName").Select
.Selection.text = (CStr(Me.RequestNameTxt &
vbNullString))
.ActiveDocument.Bookmarks("RevisionDate").Select
.Selection.text = (CStr(Me.RevisionDate &
vbNullString))
.ActiveDocument.Bookmarks("Scope").Select
.Selection.text = (CStr(Me.ScopeTxt & vbNullString))
.ActiveDocument.Bookmarks("ServiceRequestDate").Select
.Selection.text = (CStr(Me.ServiceRequestDateTxt &
vbNullString))
.ActiveDocument.Bookmarks("StartActive").Select
.Selection.text = (CStr(Me.StartActive &
vbNullString))
.ActiveDocument.Bookmarks("StartResearch").Select
.Selection.text = (CStr(Me.StartResearch &
vbNullString))
.ActiveDocument.Bookmarks("SystemComplete").Select
.Selection.text = (CStr(Me.SystemTestComplete &
vbNullString))
FunctionalAreaNum = FunctionalAreaTxt
If FunctionalAreaNum = 1 Then
strFunctional = "Professional Only"
ElseIf FunctionalAreaNum = 2 Then
strFunctional = "Institutional Only"
ElseIf FunctionalAreaNum = 3 Then
strFunctional = "Professional and Institutional"
End If
.ActiveDocument.Bookmarks("FunctionalArea").Select
.Selection.text = (CStr(strFunctional & vbNullString))
'******************Testing Considerations Block
*******************************
If Me!TestingConsNone.Value = True Then
strTestingNone = "None" & vbCrLf
ElseIf Me!TestingConsNone.Value = False Then
strTestingNone = ""
End If
If Me!TestingConsMHS.Value = True Then
strMHS = "MHS" & vbCrLf
ElseIf Me!TestingConsMHS.Value = False Then
strMHS = ""
End If
If Me!TestingConsQIPS.Value = True Then
strQIPS = "QIPS" & vbCrLf
ElseIf Me!TestingConsQIPS.Value = False Then
strQIPS = ""
End If
If Me!TestingConsCapitation.Value = True Then
strCapitation = "Capitation" & vbCrLf
ElseIf Me!TestingConsCapitation.Value = False Then
strCapitation = ""
End If
If Me!TestingConsGEOAccess.Value = True Then
strGeoAccess = "GeoAccess" & vbCrLf
Else
strGeoAccess = ""
End If
If Me!TestingOtherChk.Value = True Then
strother = "OTHER: " & Me!TestingConsiderationsOther
strTestingAll = strTestingNone & strMHS & strQIPS &
strCapitation & strGeoAccess & strother
ElseIf Me!TestingOtherChk.Value = False Then
strother = ""
strTestingAll = strTestingNone & strMHS & strQIPS &
strCapitation & strGeoAccess
End If
.ActiveDocument.Bookmarks("TestingCons").Select
.Selection.text = (CStr(strTestingAll & vbNullString))
'******************Considerations Block
*******************************
If Me!ConsiderationsNone.Value = True Then
strConsNone = "None" & vbCrLf
ElseIf Me!ConsiderationsNone.Value = False Then
strConsNone = ""
End If
If Me!ConsiderationsMHS.Value = True Then
strConsMHS = "MHS Interface" & vbCrLf
ElseIf Me!ConsiderationsMHS.Value = False Then
strConsMHS = ""
End If
If Me!ConsiderationsOptimed.Value = True Then
strConsOptimed = "Optimed" & vbCrLf
ElseIf Me!ConsiderationsOptimed.Value = False Then
strConsOptimed = ""
End If
If Me!ConsiderationsCorpDataWrhse.Value = True Then
strConsCorp = "Corporate Data Warehouse" & vbCrLf
ElseIf Me!ConsiderationsCorpDataWrhse.Value = False
Then
strConsCorp = ""
End If
If Me!ConsiderationsProviderDir.Value = True Then
strConsProv = "Provider Directory" & vbCrLf
Else
strConsProv = ""
End If
If Me!ConsiderationsSLIQ.Value = True Then
strConsSliq = "SLIQ" & vbCrLf
Else
strConsSliq = ""
End If
If Me!ConsiderationsHIPAA.Value = True Then
strConsHipaa = "HIPAA" & vbCrLf
Else
strConsHipaa = ""
End If
If Me!ConsiderationsECommerce.Value = True Then
strConsEcom = "ECommerce" & vbCrLf
Else
strConsEcom = ""
End If
If Me!ConsiderationsPlanmate.Value = True Then
strConsPlanmate = "Planmate" & vbCrLf
Else
strConsPlanmate = ""
End If
If Me!ConsiderationsOtherChk.Value = True Then
ConsidOther = "OTHER: " & Me!ConsiderationsOther
strConsAll = strConsNone & strConsMHS & strConsOptimed
& strConsCorp & strConsProv & strConsSliq & strConsEcom &
strConsPlanmate & ConsidOther
ElseIf Me!ConsiderationsOtherChk.Value = False Then
ConsidOther = ""
strConsAll = strConsNone & strConsMHS & strConsOptimed
& strConsCorp & strConsProv & strConsSliq & strConsEcom &
strConsPlanmate & ConsidOther
End If
.ActiveDocument.Bookmarks("Considerations").Select
.Selection.text = (CStr(strConsAll & vbNullString))
'******************Implementation Block
*******************************
If Me!ProgramNameChk.Value = True Then
strProgName = "Program: " &
Me!ImplChecklistProgramName & vbCrLf
Else
strProgName = ""
End If
If Me!ImplChecklistProjanChk.Value = True Then
strProj = "Program Names Added to Projan" & vbCrLf
Else
strProj = ""
End If
If Me!ImplOtherChk.Value = True Then
ImplOther = "Other: " & Me!ImplChecklistOther & vbCrLf
Else
ImplOther = ""
End If
strImplAll = strProgName & strProj & ImplOther
.ActiveDocument.Bookmarks("Implementation").Select
.Selection.text = (CStr(strImplAll & vbNullString))
End With
Else
'Perform the samething as above.
End If
'End if
Exit_Command137_Click:
Exit Sub
Err_Command137_Click:
MsgBox Err.Description
Resume Exit_Command137_Click
End Sub
Thanks in advance for your help.
R143r