Merito

Sub GetAttachments()

    Dim cn, rs, mystream
    
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.RecordSet")
    
    Set tdc = CreateObject("TDApiOle80.TDConnection")
    tdc.InitConnectionEx QC_URL
    tdc.Login UserName, GetPassword
    tdc.Connect Domain, Project
    
    Set BugFact = tdc.BugFactory
    
    cn.Open "DSN=BugZilla32s"
    rs.Open "Select d.thedata, a.filename, a.bug_id, a.description from attachments a, attach_data d Where a.attach_id = d.id", cn

    rs.MoveFirst

    While Not rs.EOF

        Set mystream = CreateObject("ADODB.Stream")
        mystream.Type = adTypeBinary
        mystream.Open
        mystream.Write rs.Fields("thedata").Value
        mystream.SaveToFile "c:\temp\" & rs.Fields("filename").Value, adSaveCreateOverWrite
        mystream.Close
        Set mystream = Nothing
            
        'Set bugObj = BugFact.Item(1037)
'fix this here
        ExternalID = rs.Fields("bug_id").Value
        Set bugObj = BugFact.NewList("SELECT * FROM BUG WHERE BG_USER_06 = " & ExternalID)
        
        For Each myBug In bugObj
             Set bugObj = BugFact.Item(myBug.ID)
             Set attachFact = bugObj.Attachments
             Set attachObj = attachFact.AddItem(rs.Fields("filename").Value)
             attachObj.Description = rs.Fields("description").Value
             attachObj.Post
             Set ExStrg = attachObj.AttachmentStorage
            'DISABLE_EXTENDED_STORAGE parameter needs to be
            'enabled if a regular user wants to upload attachments.
             ExStrg.ClientPath = "C:\temp\"
             ExStrg.Save rs.Fields("filename").Value, True
        Next
        
        rs.MoveNext
    Wend


    
    rs.Close
    Set rs = Nothing
    
    cn.Close
    Set cn = Nothing
    
    MsgBox "Get Attachments complete"
End Sub