Results 1 to 6 of 6
  1. #1
    Lounger
    Join Date
    Nov 2008
    Location
    Sydney, New South Wales, Australia
    Posts
    27
    Thanks
    0
    Thanked 1 Time in 1 Post
    Hi everyone - does anyone know why this code throws the below error at '*** Runtime... (as per code below). It is supposed to create a Folder in default document location but it throws error. I've set references for Scripting and Word Object.
    Thank you for any assistance.

    Option Compare Database
    Option Explicit


    Private Sub cboSelect_AfterUpdate()
    'Created by Helen Feddema 22-Nov-2006
    'Modified by Helen Feddema 22-Nov-2006

    On Error GoTo ErrorHandler

    Dim strSearch As String

    strSearch = "[ContactID] = " & Me![cboSelect]

    'Find the record that matches the control
    Me.RecordsetClone.FindFirst strSearch
    Me.Bookmark = Me.RecordsetClone.Bookmark

    ErrorHandlerExit:
    Exit Sub

    ErrorHandler:
    MsgBox "Error No: " & Err.Number _
    & "; Description: " & Err.Description
    Resume ErrorHandlerExit

    End Sub

    Private Sub cmdClose_Click()
    'Created by Helen Feddema 22-Nov-2006
    'Modified by Helen Feddema 22-Nov-2006

    On Error Resume Next

    Dim prj As Object

    Set prj = Application.CurrentProject

    If prj.AllForms("fmnuMain").IsLoaded Then
    Forms![fmnuMain].Visible = True
    Else
    DoCmd.OpenForm "fmnuMain"
    End If

    DoCmd.Close acForm, Me.Name

    End Sub


    Private Sub cmdCreateWordLetter_Click()
    'Created by Helen Feddema 22-Nov-2006
    'Modified by Helen Feddema 22-Nov-2006
    'Requires references to the Word and Scripting Runtime Libraries

    Dim appWord As Word.Application
    Dim doc As Word.Document
    Dim docs As Word.Documents
    Dim fil As Scripting.File
    Dim fld As Scripting.Folder
    Dim fso As New Scripting.FileSystemObject
    Dim prps As Object
    Dim strCompanyFolderPath As String
    Dim strCompanyName As String
    Dim strContactName As String
    Dim strDate As String
    Dim strDocsDir As String
    Dim strLetter As String
    Dim strPrompt As String
    Dim strTemplate As String
    Dim strTemplateDir As String

    On Error GoTo ErrorHandler

    Set appWord = GetObject(, "Word.Application")
    strDate = Format(Date, "d MMMM yyyy")

    strTemplateDir = _
    appWord.Options.DefaultFilePath(wdUserTemplatesPat h) & "\"
    Debug.Print "Office templates directory: " & strTemplateDir
    strDocsDir = _
    appWord.Options.DefaultFilePath(wdDocumentsPath) & "\"
    Debug.Print "Office documents directory: " & strDocsDir
    strTemplate = strTemplateDir & "DocProps.dot"
    Debug.Print "Letter: " & strTemplate

    On Error Resume Next
    'Look for template in Templates folder, and put up a message
    'if it is not found
    Set fil = fso.GetFile(strTemplate)
    If fil Is Nothing Then
    strPrompt = "Can't find " & strTemplate & " in " _
    & strTemplateDir & " folder; canceling"
    MsgBox strPrompt, vbCritical + vbOKOnly
    GoTo ErrorHandlerExit
    End If

    On Error GoTo ErrorHandler
    'Check whether there is a folder for this company, and
    'create it if not found (removing characters that can't be
    'used in folder names)
    strCompanyName = StripChars(Nz(Me![CompanyName]))
    strCompanyFolderPath = strDocsDir & strCompanyName
    strContactName = Nz(Me![txtFirstName] & " " _
    & Me![txtLastName])
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(strCompanyFolderPath)
    strLetter = strCompanyFolderPath & "\Letter to " _
    & strContactName & ".docx"
    Debug.Print "Letter save name: " & strLetter

    Set docs = appWord.Documents
    Set doc = docs.Add(Template:=strTemplate, _
    documenttype:=wdDocument, Visible:=True)

    Set prps = doc.CustomDocumentProperties

    With prps
    .Item("TodayDate").Value = strDate
    .Item("Name").Value = strContactName
    .Item("Address").Value = Nz(Me![txtStreetAddress])
    .Item("Salutation").Value = Nz(Me![txtSalutation])
    .Item("CompanyName").Value = Nz(Me![txtCompanyName])
    .Item("City").Value = Nz(Me![txtCity])
    .Item("StateProv").Value = Nz(Me![txtStateOrProvince])
    .Item("PostalCode").Value = Nz(Me![txtPostalCode])
    .Item("JobTitle").Value = Nz(Me![txtJobTitle])
    End With

    doc.SaveAs filename:=strLetter

    With appWord
    .Visible = True
    .Activate
    .Selection.WholeStory
    .Selection.Fields.Update
    .Selection.MoveDown Unit:=wdLine, Count:=1
    End With

    ErrorHandlerExit:
    Exit Sub

    ErrorHandler:
    If Err = 429 Then
    'Word is not running; open Word with CreateObject
    Set appWord = CreateObject("Word.Application")
    Resume Next
    ElseIf Err.Number = 76 Then
    'Create folder
    Set fld = fso.CreateFolder(strCompanyFolderPath) ' *** Runtime error 52 Bad file name or number
    Resume Next
    Else
    MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
    Resume ErrorHandlerExit
    End If

    End Sub

    Private Sub Form_Current()
    'Created by Helen Feddema 22-Nov-2006
    'Modified by Helen Feddema 22-Nov-2006

    On Error Resume Next

    Me![cboSelect] = Null

    End Sub

    Private Sub Form_Load()
    'Created by Helen Feddema 22-Nov-2006
    'Modified by Helen Feddema 22-Nov-2006

    On Error Resume Next

    DoCmd.RunCommand acCmdSizeToFitForm

    End Sub

    Public Function StripChars(strText As String) As String
    'Strips a spaces and parentheses from a text string
    'Created by Helen Feddema 10-15-97
    'Modified by Ruud H.G. van Tol 6-18-99
    'Modified by Brad Beacham 6-Feb-2005
    'Last modified by Helen Feddema 7-Feb-2005

    On Error GoTo ErrorHandler

    Dim strTestString As String
    Dim strBadChar As String
    Dim i As Integer
    Dim strStripChars As String

    strStripChars = "`~!@#$%^&*()-_=+[{]};:',<.>/?" & Chr$(34)
    strTestString = strText

    For i = 1 To Len(strStripChars)
    strBadChar = Mid(strStripChars, i, 1)
    strTestString = Replace(strTestString, strBadChar, vbNullString)
    Next

    StripChars = strTestString

    ErrorHandlerExit:
    Exit Function

    ErrorHandler:
    MsgBox "Error No: " & Err.Number & "; Description: " & _
    Err.Description
    Resume ErrorHandlerExit

    End Function

  2. #2
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts
    If you MsgBox(strCompanyFolderPath) is it a valid folder name?

    Does the parent folder of the new folder exist? (In case you must create each folder in the path in sequence... I can't recall.)

  3. #3
    Lounger
    Join Date
    Nov 2008
    Location
    Sydney, New South Wales, Australia
    Posts
    27
    Thanks
    0
    Thanked 1 Time in 1 Post
    Quote Originally Posted by jscher2000 View Post
    If you MsgBox(strCompanyFolderPath) is it a valid folder name?

    Does the parent folder of the new folder exist? (In case you must create each folder in the path in sequence... I can't recall.)
    Thanks for your interest. The code creates the folder if it does not exist - then it will put future documents into the created folder.

  4. #4
    Super Moderator
    Join Date
    Jun 2002
    Location
    Mt Macedon, Victoria, Australia
    Posts
    3,993
    Thanks
    1
    Thanked 45 Times in 44 Posts
    You did not answer the question.

    Quote Originally Posted by jscher2000 View Post
    If you MsgBox(strCompanyFolderPath) is it a valid folder name?
    A msgbox is on quick way to inspect the value of a variable.

    You might also try Msgbox(strDocsDir) to check what is in there.
    Regards
    John



  5. #5
    Lounger
    Join Date
    Nov 2008
    Location
    Sydney, New South Wales, Australia
    Posts
    27
    Thanks
    0
    Thanked 1 Time in 1 Post
    Quote Originally Posted by jscher2000 View Post
    If you MsgBox(strCompanyFolderPath) is it a valid folder name?

    Does the parent folder of the new folder exist? (In case you must create each folder in the path in sequence... I can't recall.)
    You are correct John I misssed the Parent folder - yes the parent folder exists and I will try your suggestion

  6. #6
    Lounger
    Join Date
    Nov 2008
    Location
    Sydney, New South Wales, Australia
    Posts
    27
    Thanks
    0
    Thanked 1 Time in 1 Post
    Quote Originally Posted by jec1 View Post
    You are correct John I misssed the Parent folder - yes the parent folder exists and I will try your suggestion
    John

    I just tried the database again before I tried the msgboxes. It actually created the folder and saved the letter in the folder this time - it is still in .doc format but it saved it to the last known document path (which today was my NAS drive).

    This happens a lot with 2010 - it likes being shutdowns and restarted especially when I've been testing ribbon addins for Word (not Access).

    Thank you for the msgbox idea - I forget I can use them to see results.

    I'll see how it goes when I convert the database to 2010 Access.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •