Got the answer, thanks to Mattias and Douglas Steele. A MS-Word macro can be
refered to from Access via...
wdAppObjVariable.ActiveDocument.MacroName
--
LF
"LF" wrote:
> Is there a way to initiate a MS-Word macro from access? If not, I'd
> appreciate help with converting the VBA below to an Access 2K3 function that
> would control the MS-Word functionality.
>
> Sub CSVdelimitTable()
> 'prompt user warning and save copy of file with a .CSV extension
> Dim theResponse, theFileName
> 'theResponse = MsgBox("Pleace click Cancel if current file contains
> anything other than a single table." And Chr(13) And Chr(10) And Chr(13) And
> Chr(10) And "Click OK to save a copy of the file in the form of comma
> seperated values which is openable by Excel and database importable.",
> vbOKCancel, "CSV Warning!")
> If theResponse = vbOK Then
> 'theFileName = ActiveDocument.Name
> 'theFileName = Mid(theFileName, 1, Len(theFileName) - 4)
> 'theFileName = theFileName + ".CSV"
> 'ChangeFileOpenDirectory ActiveDocument.Path
> 'ActiveDocument.SaveAs FileName:=theFileName, FileFormat:=wdFormatDocument
> 'Else
> Exit Sub
> End If
> 'set view to Page Layout in order to access header/footer
> If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
> ActiveWindow.Panes(2).Close
> End If
> If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
> ActivePane.View.Type = wdOutlineView Or
> ActiveWindow.ActivePane.View.Type _
> = wdMasterView Then
> ActiveWindow.ActivePane.View.Type = wdPageView
> End If
> 'remove header and footer to avoid them being saved as delimited rows
> ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
> Selection.WholeStory
> Selection.Delete Unit:=wdCharacter, Count:=1
> If Selection.HeaderFooter.IsHeader = True Then
> ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
> Else
> ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
> End If
> Selection.WholeStory
> Selection.Delete Unit:=wdCharacter, Count:=1
> ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
> 'search/replace all table paragraph returns with intermediate values
> Selection.Tables(1).Select
> With Selection.Find
> .Text = "^p"
> .Replacement.Text = "$$EMBEDDED_RETURN$$"
> .Forward = True
> .Wrap = wdFindStop
> .Format = False
> .MatchCase = False
> .MatchWholeWord = False
> .MatchWildcards = False
> .MatchSoundsLike = False
> .MatchAllWordForms = False
> End With
> Selection.Find.Execute Replace:=wdReplaceAll
> 'search/replace all table tabs with intermediate values
> With Selection.Find
> .Text = "^t"
> .Replacement.Text = "$$EMBEDDED_TAB$$"
> .Forward = True
> .Wrap = wdFindContinue
> .Format = False
> .MatchCase = False
> .MatchWholeWord = False
> .MatchWildcards = False
> .MatchSoundsLike = False
> .MatchAllWordForms = False
> End With
> Selection.Find.Execute Replace:=wdReplaceAll
> 'double quote all table quotes
> With Selection.Find
> .Text = """"
> .Replacement.Text = """"""
> .Forward = True
> .Wrap = wdFindContinue
> .Format = False
> .MatchCase = False
> .MatchWholeWord = False
> .MatchWildcards = False
> .MatchSoundsLike = False
> .MatchAllWordForms = False
> End With
> Selection.Find.Execute Replace:=wdReplaceAll
> 'convert table cells to text
> Selection.Rows.ConvertToText Separator:=wdSeparateByTabs
> 'insert quote text qualifiers and a comma between each field value
> With Selection.Find
> .Text = "^t"
> .Replacement.Text = ""","""
> .Forward = True
> .Wrap = wdFindStop
> .Format = False
> .MatchCase = False
> .MatchWholeWord = False
> .MatchWildcards = False
> .MatchSoundsLike = False
> .MatchAllWordForms = False
> End With
> Selection.Find.Execute Replace:=wdReplaceAll
> 'insert quote text qualifiers at end of each record
> With Selection.Find
> .Text = "^p"
> .Replacement.Text = """^p"""
> .Forward = True
> .Wrap = wdFindStop
> .Format = False
> .MatchCase = False
> .MatchWholeWord = False
> .MatchWildcards = False
> .MatchSoundsLike = False
> .MatchAllWordForms = False
> End With
> Selection.Find.Execute Replace:=wdReplaceAll
> 'insert a quote text qualifier before the first word
> Selection.HomeKey Unit:=wdLine
> Selection.TypeText Text:=""""
> 're-establish embedded returns
> With Selection.Find
> .Text = "$$EMBEDDED_RETURN$$"
> .Replacement.Text = "^p"
> .Forward = True
> .Wrap = wdFindContinue
> .Format = False
> .MatchCase = False
> .MatchWholeWord = False
> .MatchWildcards = False
> .MatchSoundsLike = False
> .MatchAllWordForms = False
> End With
> Selection.Find.Execute Replace:=wdReplaceAll
> 're-establish embedded tabs
> With Selection.Find
> .Text = "$$EMBEDDED_TAB$$"
> .Replacement.Text = "^t"
> .Forward = True
> .Wrap = wdFindContinue
> .Format = False
> .MatchCase = False
> .MatchWholeWord = False
> .MatchWildcards = False
> .MatchSoundsLike = False
> .MatchAllWordForms = False
> End With
> Selection.Find.Execute Replace:=wdReplaceAll
> 'delete last line to avoid corruption of last row
> Selection.EndKey Unit:=wdStory, Extend:=wdMove
> Selection.TypeBackspace
> Selection.TypeBackspace
> 'return cursor to top of document and save file as Text Only filetype
> Selection.HomeKey Unit:=wdStory
> ActiveDocument.SaveAs FileFormat:=wdFormatText
> End Sub
> --
> LF
|
Similar Threads
