open word "save as" dialogue box

[krowe]

Hi all

Sorry to keep returning, but my DB is starting to be really functional with all your help!

I am using this code to run a mail merge:

DoCmd.SetWarnings False
Dim mypath As String
Dim mypath3 As String
Dim Wordpath As String
Dim folder As String
Dim sDBPath As String
Dim oApp As Word.Application
Dim ThisDB As String
Dim oWord As Word.Document
Dim oMainDoc As Word.Document
  
    Wordpath = Environ("office") & "\winword.exe"
    mypath = Left$(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir$(CurrentDb.Name)))
    mypath3 = ("" & mypath & "merge test.doc""")
    ThisDB = CurrentDb.Name
        
    DoCmd.RepaintObject , ""
    DoCmd.OpenQuery "qryForLetterTemplate2", acViewNormal, acEdit
    folder = CurrentProject.Path & "\"
    
    Set oApp = CreateObject("Word.Application")
    Set oWord = oApp.Documents.Open(FileName:=mypath3)
    oApp.Visible = True
    With oWord.MailMerge
            .MainDocumentType = wdFormLetters
      '  sDBPath = folder & "new housing database v7 FE.mdb"
            sDBPath = ThisDB
            .OpenDataSource Name:=sDBPath, _
            SQLStatement:="SELECT * FROM [tblCurrentClientForLetterTemplate]"
    End With
    With oWord
        .MailMerge.Destination = wdSendToNewDocument
        .MailMerge.Execute
    End With
    
    oApp.Activate
    oApp.Documents.Parent.Visible = True
    oApp.Application.WindowState = 1
    oApp.ActiveWindow.WindowState = 1
    oWord.Close

This results in a word file open called Letters1 (i think, at least thats what the title bar has in it)

I want to go one step further though...

I have a filing system whereby there is a folder for each letter of the alphabet. I have other code that use use to open the correct folder:

Dim FirstLetter As String
FirstLetter = Left(Me!Surname, 1)
Dim FolderPath As String
FolderPath = "N:\CASEWORK"
Shell "C:\WINDOWS\explorer.exe """ & FolderPath & "\" & FirstLetter & "", vbNormalFocus

I would like the mail merge code to do something simiar to the open folder code, in that, after the code runs I want a word Save As dialogue box to open which is already pointing to the correct folder.

The only ideas I have so far is that I could use something like this:

Dim FirstLetter As String
FirstLetter = Left(Me!Surname, 1)
Dim FolderPath As String
FolderPath = "N:\CASEWORK"
oApp.SaveAs Filename:=FolderPath & "\" & FirstLetter & ".doc"

except it seems to break on the last line and i'm not sure what it should be.

Sorry for the long post, hope i've explained what id like to do well enough.

Kev

 

[krowe]

Hi Again

I have been working on this this morning and have found a function that should be able to set the default save location, so trying to put this into my code.

I have this so far:

Option Compare Database
Private Sub Command11_Click()
DoCmd.SetWarnings False
Dim mypath As String
Dim mypath3 As String
Dim Wordpath As String
Dim folder As String
Dim sDBPath As String
Dim oApp As Word.Application
Dim ThisDB As String
Dim oWord As Word.Document
Dim oMainDoc As Word.Document
[B][COLOR=red]'next 4 lines of code is new[/COLOR][/B]
[B][COLOR=red]   Dim FirstLetter As String[/COLOR][/B]
[B][COLOR=red]   FirstLetter = Left(Me!Surname, 1)[/COLOR][/B]
[B][COLOR=red]   Dim FolderPath As String[/COLOR][/B]
[B][COLOR=red]   SaveFolderPath = "N:\CASEWORK"[/COLOR][/B]
  
    Wordpath = Environ("office") & "\winword.exe"
    mypath = Left$(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir$(CurrentDb.Name)))
    mypath3 = ("" & mypath & "merge test.doc""")
    ThisDB = CurrentDb.Name
 
    DoCmd.RepaintObject , ""
    DoCmd.OpenQuery "qryForLetterTemplate2", acViewNormal, acEdit
    folder = CurrentProject.Path & "\"
 
 [COLOR=red]  [B]Set oApp = CreateObject("Word.Application")[/B][/COLOR]
[B][COLOR=red]   Set oAppOptions = oApp.Options                                 [/COLOR][/B]
[B][COLOR=red]   oAppOptions.DefaultFilePath(wdStartupPath) = SaveFolderPath & "\" & FirstLetter    [/COLOR][/B]
 
    Set oWord = oApp.Documents.Open(FileName:=mypath3)
    oApp.Visible = True
    With oWord.MailMerge
            .MainDocumentType = wdFormLetters
            sDBPath = ThisDB
            .OpenDataSource Name:=sDBPath, _
            SQLStatement:="SELECT * FROM [tblCurrentClientForLetterTemplate]"
    End With
    With oWord
        .MailMerge.Destination = wdSendToNewDocument
        .MailMerge.Execute
    End With
 
    oApp.Activate
    oApp.Documents.Parent.Visible = True
    oApp.Application.WindowState = 1
    oApp.ActiveWindow.WindowState = 1
    oWord.Close
 
    'close merge test
 
    ' On Error Resume Next
   ' Documents(" & mypath3").Close SaveChanges:=wdDoNotSaveChanges
  ' If Err.Number = 4160 Then
  '      MsgBox "The file specified is not open.", vbCritical Or vbOKOnly, _
 '          "File Not Open"
'  End If
 '  On Error GoTo 0
DoCmd.SetWarnings True
End Sub

I think this is closer to a solution that i need, but the reference to the form field Surname is causing an error. The code is run from a button on the form that contains the field Surname, so I thought Me!Surname should return the value stored in this box.

Can anyone point to what wrong with this.

Thanks

Kev

 

[krowe]

Hi again

I'm still working on this and thought I'd post an update of the code i've now got.

I realised the Me!Surname wouldn't work as the button was on a subform, so now using parent!surname which doesnt throw up an error, so now experimenting with different DefaultFilePath codes, but none seem to work.

DoCmd.SetWarnings False
Dim mypath As String
Dim mypath3 As String
Dim Wordpath As String
Dim folder As String
Dim sDBPath As String
Dim oApp As Word.Application
Dim ThisDB As String
Dim oWord As Word.Document
Dim oMainDoc As Word.Document
Dim FirstLetter As String
Dim SaveFolderPath As String
 
   FirstLetter = Left(Parent!Surname, 1)
   SaveFolderPath = "N:\CASEWORK"
    Wordpath = Environ("office") & "\winword.exe"
    mypath = Left$(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir$(CurrentDb.Name)))
    mypath3 = ("" & mypath & "merge test.doc""")
    ThisDB = CurrentDb.Name
 
    DoCmd.RepaintObject , ""
    DoCmd.OpenQuery "qryForLetterTemplate2", acViewNormal, acEdit
    folder = CurrentProject.Path & "\"
 
    Set oApp = CreateObject("Word.Application")
    Set oAppOptions = oApp.Options
    oAppOptions.DefaultFilePath(wdCurrentFolderPath) = "" & SaveFolderPath & "\" & FirstLetter & ""
    Set oWord = oApp.Documents.Open(FileName:=mypath3)
    oApp.Visible = True
    With oWord.MailMerge
            .MainDocumentType = wdFormLetters
            sDBPath = ThisDB
            .OpenDataSource Name:=sDBPath, _
            SQLStatement:="SELECT * FROM [tblCurrentClientForLetterTemplate]"
    End With
    With oWord
        .MailMerge.Destination = wdSendToNewDocument
        .MailMerge.Execute
    End With
 
    oApp.Activate
    oApp.Documents.Parent.Visible = True
    oApp.Application.WindowState = 1
    oApp.ActiveWindow.WindowState = 1

The wdCurrentFolderPath is the closest I get, but get an error saying this is a read only property and connt be changed.

Would be grateful for any pointers.

Thanks

 

[vbaInet]

It looks like you are not getting any response yet.

Something like this perhaps:

http://www.ammara.com/access_image_faq/file_open_dialog.html