Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Clean up code and port to Mac
Hi,
I've pieced together the following code based on advice I got on this forum and others and from sites referenced by people here. It finally works (well almost) on Windows with Office 2003. The only problem is it still saves the changes in the "template" file, even though I specify not to. I need to clean it up, optimize it and maximize the chances it will run in Office 2007, Office 2003 and Office:mac 2004. Right now it dies almost immediately on the Mac. I have not tested on Office 2007 yet. Would some kind soul be willing to halp me with this? This is what it should do in words: 1. Open worksheet with Data for Merge (Data Table2) 2. Ask the user what Word template to use (using standard dialog boxes) 3. Ask the user what directory to store the final output (using standard dialog box) 4. Export the Data in Data Table2 to a CSV file 5. Open the Word Template file 6. Connect the CSV file to it as a data source 7. Merge to New Document 8. Save the new merge document with an Excel derived name 9. Close the template file without saving changes 10. Delete the CSV file 11. Activate the new Word Document and do a spell check Here's the code as is: Sub ExportDataTable2() ' ' ExportDataTable2 Macro ' ' Sheets("Data Table2").Select Const Delimiter = "\" Const ForReading = 1, ForWriting = 2, ForAppending = 3 Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 WriteFileName = Range("C1").Value ' File Name generated and stored in Excel ' Ask User What template file to use Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False .Title = "Select Report Template to use:" .InitialFileName = "" If .Show = -1 Then TempPathName = .SelectedItems(1) Else Exit Sub End If End With 'MsgBox "You have selected this template: " & TempPathName ' Ask User what path to store the data to ' Dim objShell As Object, objFolder As Object Set objShell = CreateObject("Shell.Application") On Error Resume Next Set objFolder = objShell.BrowseForFolder(&H0&, "Select a Folder to Store This Data ", &H1&) If Not objFolder Is Nothing Then Set oFolderItem = objFolder.Items.Item FPath = oFolderItem.path + "\" 'MsgBox "You have select to save your data to: " & FPath End If ' Ignore first row - headers Range("A2").Select x = ActiveCell.Row y = ActiveCell.Column z = 0 Do While Cells(x, y).Value < "" x = x + 1 z = z + 1 Loop 'MsgBox "There are " & z & " rows in the data range. Export to CSV file " & WriteFileName & "?" ' Write data to CSV file Set fswrite = CreateObject("Scripting.FileSystemObject") 'Set path names CSVPathName = FPath + WriteFileName + ".csv" DocPathName = FPath + WriteFileName + ".doc" ' Open and export data to CSV File fswrite.CreateTextFile CSVPathName Set fwrite = fswrite.GetFile(CSVPathName) Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault) LastRow = z + 1 LastCol = 2 With Sheets("Data Table2") For ColCount = 1 To LastCol OutputLine = "" For RowCount = 2 To LastRow If OutputLine = "" Then OutputLine = Cells(RowCount, ColCount).Value 'MsgBox "OutputLine = " & OutputLine Else 'If ColCount = 2 Then MsgBox RowCount & ": " & Cells(RowCount, ColCount).Value OutputLine = OutputLine & Delimiter & Cells(RowCount, ColCount).Value End If Next RowCount tswrite.writeline OutputLine Next ColCount End With tswrite.Close 'MsgBox "CSV has been written!" ' Sub ControlWordFromXL() - Open Word Dim oWord As Word.Application Dim WordWasNotRunning As Boolean 'Get existing instance of Word if it's open; otherwise create a new one On Error Resume Next Set oWord = GetObject(, "Word.Application") If Err Then Set oWord = New Word.Application WordWasNotRunning = True End If On Error GoTo Err_Handler oWord.Visible = True ' ' Open the template, merge and save file ' OpenTemplateAndMerge CSVPathName, DocPathName, TempPathName 'MsgBox "File was saved to " & DocPathName ' ' Delete CSV File ' Kill CSVPathName ' MergeSpellCheck ' ' ' Set the language for the document. oWord.Selection.WholeStory oWord.Selection.LanguageID = wdEnglishUS oWord.Selection.NoProofing = False ' Perform Spelling/Grammar check. If oWord.Options.CheckGrammarWithSpelling = True Then oWord.ActiveDocument.CheckGrammar Else oWord.ActiveDocument.CheckSpelling End If If WordWasNotRunning Then oWord.Quit End If 'Make sure you release object references. Set oWord = Nothing 'quit Exit Sub Err_Handler: MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " _ & Err.Number If WordWasNotRunning Then oWord.Quit End If 'End Sub End Sub Sub OpenTemplateAndMerge(CSVPathName, DocPathName, TempPathName) ' ' CSVPathName = full path to merge data file ' DocPathName = full path to final merge file ' TempPathName = full path to report template ' 'Dim WordApp As Word.Application Dim Template As Word.Document 'MsgBox "In OpenTemplateAndMerge Subroutine" ' Open the Report Template Set Template = Word.Documents.Open(TempPathName) 'Old WAY I opened the template 'Documents.Open Filename:=TempPathName, _ ' ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _ ' PasswordDocument:="", PasswordTemplate:="", Revert:=False, _ ' WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _ 'wdOpenFormatAuto, XMLTransform:="" CommandBars("Control Toolbox").Visible = False ' ActiveDocument.MailMerge.MainDocumentType = wdFormLetters ' Open merge data source file and merge to new document ActiveDocument.MailMerge.OpenDataSource Name:=CSVPathName, _ ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _ AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _ WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _ Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _ :="", SubType:=wdMergeSubTypeOther With ActiveDocument.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource ' Data source will always have only one record .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord End With .Execute Pause:=False End With ' Save Merged File to DocPathName ActiveDocument.SaveAs Filename:=DocPathName, FileFormat _ :=wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _ True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _ False, SaveNativePictureFormat:=False, SaveFormsData:=False, _ SaveAsAOCELetter:=False ' Close Template File Template.Close (SaveChanges = False) ' Still saves the file changes End Sub -- Thanks, Andy |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
clean up code a little | Excel Discussion (Misc queries) | |||
help me clean up this code | Excel Programming | |||
Capturing Data from a Com Port or Printer Port | Excel Programming | |||
Clean up code. | Excel Programming | |||
Help clean up this code... | Excel Programming |