none
Creating Custom Attach addin (toolbar) in VBA and receive an object error RRS feed

  • Question

  • I am creating an attach tool bar in Word 2010. I can click on the button (in Add ins) and it will let me browse to my document. However when I select a document but after I click Insert I get the error ""The request member of the collection does not exist." When I step through the code It seems to always break in the Private Sub CreateAttachToolBar()

    Const StartSectionCnt = 1
    Public Sub turnontoolbarsonload()
        CommandBars("Attachments").Visible = True
        CommandBars("Insert Attachments").Visible = True
    End Sub
    Public Sub CheckDocType()
      Dim MsgText As String
      Dim MsgResp As Integer
      If CommandBars("Attachments").Controls.Count = 0 Then
        CommandBars("Attachments").Visible = False
      Else
          CommandBars("Attachments").Visible = True
      End If
      Doc = Application.ActiveWindow.Caption
      MsgText = "Applications Need To Be A Template Type." + Chr(13) + _
                "Please Refer To Section In The User Manual Labeled" + Chr(13) + _
                "Completing the Application Form For Further Information."
      If ActiveDocument.Type <> wdTypeTemplate Then
        MsgResp = MsgBox(MsgText, vbOKOnly)
        Application.OnTime When:=Now, Name:="CloseDocument"
      End If
    End Sub
    Public Sub CloseDocument()
      Application.ActiveDocument.Close (wdDoNotSaveChanges)
    End Sub
    Public Sub InsertAttachment()
    Dim MsgResp As Integer
    Dim I As Integer
    Dim MsgText As String
    Dim ContentStr As Template
    MsgText = "Attachments Already On Application." + Chr(13) + _
              "Do You Want To Replace?"
    On Error GoTo Error_Handler
    Set ContentStr = CustomizationContext
    CustomizationContext = ActiveDocument
    If ActiveDocument.Bookmarks.Exists("Attachments") = True Then
        MsgResp = MsgBox(MsgText, vbYesNo)
    End If
    If MsgResp <> vbNo Then
      ActiveDocument.Unprotect ("pass")
      If MsgResp = vbYes Then
        Selection.GoTo what:=wdGoToBookmark, Name:="Attachments"
        ActiveDocument.Bookmarks("Attachments").Delete
        Selection.EndKey unit:=wdStory, Extend:=wdExtend
        Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
        Selection.Delete
      End If
      Selection.EndKey unit:=wdStory
      ActiveDocument.Bookmarks.Add Name:="Attachments"
      Selection.InsertBreak (wdSectionBreakNextPage)
      dlg = Dialogs(wdDialogInsertFile).Show
      Call CreateAttachToolBar
    Error_Handler:
      If Err.Number <> 0 Then
        MsgBox (Err.Description)
      End If
      ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="sampson"
      CustomizationContext = ContentStr
      CommandBars("Attachments").Visible = True
    End If
    End Sub
    Private Sub CreateAttachToolBar()
    Dim FF_Num As Integer
    Dim FF_Num_Str As String
    Dim CurrentLevel As Integer
    Dim FoundFF As Boolean
    Dim BtnCnt As Integer
    Dim btnForm() As CommandBarControl
      On Error GoTo Error_Handler
    '  For I = 1 To ActiveDocument.CommandBars.Count
    '    If CommandBars(I).Name = "Attachments" Then
    '       CommandBars(I).Delete
    '   End If
    '  Next I
      FF_Num = 1
      KeyBindings.ClearAll
      Do While CommandBars("Attachments").Controls.Count > 0
        CommandBars("Attachments").Controls(1).Delete
      Loop
      CurrentLevel = 0
      BtnCnt = 0
      Do While FF_Num + StartSectionCnt <= ActiveDocument.Sections.Count
        FF_Num_Str = Trim(Str(FF_Num))
        Selection.GoTo what:=wdGoToSection, which:=wdGoToAbsolute, Count:=(FF_Num + StartSectionCnt)
        If ActiveDocument.FormFields("Level" + FF_Num_Str).Result > CurrentLevel Then
          If CurrentLevel = BtnCnt Then
            BtnCnt = BtnCnt + 1
            ReDim Preserve btnForm(BtnCnt)
          End If
          CurrentLevel = CurrentLevel + 1
        Else
          If ActiveDocument.FormFields("Level" + FF_Num_Str).Result < CurrentLevel Then
            CurrentLevel = CurrentLevel - 1
          End If
        End If
        If CurrentLevel = 1 Then
          Set btnForm(BtnCnt) = ActiveDocument.CommandBars("Attachments").Controls.Add(msoControlPopup, , , , False)
          btnForm(BtnCnt).Caption = "Attachments"
          Call PullInAttachments(FF_Num, btnForm(BtnCnt), CurrentLevel)
        Else
          If ActiveDocument.FormFields("Level" + FF_Num_Str).Result = CurrentLevel Then
             Set btnForm(CurrentLevel) = btnForm(CurrentLevel - 1).Controls.Add(msoControlPopup)
             btnForm(CurrentLevel).Caption = ActiveDocument.FormFields("Folder" + FF_Num_Str).Result
             Call PullInAttachments(FF_Num, btnForm(CurrentLevel), CurrentLevel)
          End If
        End If
      Loop
    Error_Handler:
      If Err.Number <> 0 Then
        MsgBox (Err.Description)
      End If
    End Sub
    Private Sub PullInAttachments(FF_Num As Integer, _
                                  btnForm As CommandBarControl, _
                                  CurrentLevel As Integer)
    Dim FF_Num_Str As String
      FF_Num_Str = Trim(Str(FF_Num))
      ActiveDocument.FormFields("Level" + FF_Num_Str).Delete
      ActiveDocument.FormFields("Folder" + FF_Num_Str).Delete
      Selection.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=1
      Set SortTable = ActiveDocument.Tables(ActiveDocument.Tables.Count)
      TabCnt = ActiveDocument.Tables.Count
      For I = 1 To ActiveDocument.Sections(FF_Num + StartSectionCnt).Range.Bookmarks.Count
        If I > 1 Then
          SortTable.Rows.Add
        End If
        SortTable.Cell(I, 1).Range.InsertAfter UCase(ActiveDocument.Sections(FF_Num + StartSectionCnt).Range.Bookmarks(I).Name)
      Next I
      If SortTable.Rows.Count > 1 Then
         SortTable.Sort ExcludeHeader:=False, FieldNumber:=1, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
      End If
      For I = 1 To ActiveDocument.Sections(FF_Num + StartSectionCnt).Range.Bookmarks.Count
        Set cmbSubControl = btnForm.Controls.Add(msoControlButton, , , , False)
        Caption = Mid(SortTable.Cell(I, 1), 1, Len(SortTable.Cell(I, 1)) - 2)
        With cmbSubControl
          .Caption = Caption
          .OnAction = "GetAttachment"
          .Parameter = Caption
        End With
      Next I
      SortTable.Delete
      FF_Num = FF_Num + 1
    End Sub
    Private Sub GetAttachment()
      Dim Doc As String
      Dim Doc2 As String
      Dim WordDoc As Boolean
          
      On Error GoTo Error_Handler
      ActiveDocument.Unprotect ("pass")
      Doc = Application.ActiveWindow.Document.Name
      ActiveDocument.Bookmarks.Add Name:="LeftOff"
      Selection.GoTo what:=wdGoToBookmark, Name:=CommandBars.ActionControl.Parameter
      Selection.InlineShapes(1).OLEFormat.Activate
      WordDoc = False
      If Application.ActiveWindow.Document.Name <> Doc Then
        Doc2 = Application.ActiveWindow.Document.Name
        WindowsIndex = 0
        Do While Application.ActiveWindow.Document.Name <> Doc
          WindowsIndex = WindowsIndex + 1
          Documents(WindowsIndex).Activate
        Loop
        WordDoc = True
      End If
      Selection.GoTo what:=wdGoToBookmark, Name:="LeftOff"
      ActiveDocument.Bookmarks("LeftOff").Delete
    Error_Handler:
      If Err.Number <> 0 Then
        MsgBox (Err.Description)
      End If
      ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="sampson"
      If WordDoc Then
        Documents(Doc2).Activate
      End If
    End Sub


    jim neal



    • Edited by JamesLNeal Wednesday, August 29, 2012 1:15 AM
    Wednesday, August 29, 2012 1:12 AM

Answers

  • The issue was not with the code but with the creation of an attachment collection. One the collection was created the above code did what was intended.

    jim neal

    • Marked as answer by JamesLNeal Thursday, August 30, 2012 2:08 AM
    Thursday, August 30, 2012 2:08 AM