want to be able to search for attachments and delete them is they

[Guest]

I have a form that is used over and over each day. The first time it is used
is frome scratch but the rest of the day (10-15 times a day) it is pulled
from the Sent Items folder.

First thing I do is to see if they want to resubmit the form. If they reply
Yes, then I want to look for attachments already in the form and delete them.
This is where I think it goes. But I don't know enough about vba. I think
it goes around line 104. Any and all help is needed.


'-=-=-=-=-=-=-=-=-=-
Function Item_Open()
' Pull down for client information
Dim rst1
Dim dao
Dim wks
Dim db
Dim nms
Dim fld
Dim itms
Dim itm
Dim ctl
Dim strAccessDir
Dim objAccess
Dim CategoryArray(99,2)
Dim CustomerArrary(99,2)

'Pick up path to Access database directory from Access SysCmd function
Set objAccess = Item.Application.CreateObject("Access.Application")
strDBName = ("\\tabsnas\database$\edgar\newcigars\newcigars3.mdb")
'MsgBox "DBName: " & strDBName
objAccess.Quit

'Set up reference to Access database
Set dao = Application.CreateObject("DAO.DBEngine.36")
Set wks = dao.Workspaces(0)
Set db = wks.OpenDatabase(strDBName)

'-=-=-=-=-=-=-=-=-=-=-
'Retrieve Category info from table
'-=-=-=-=-=-=-=-=-=-=-
Set rst1 = db.OpenRecordset("dbPCConlist")
Set ctl =
Item.GetInspector.ModifiedFormPages("Message").Controls("cboConlist")
ctl.ColumnCount = 2
ctl.ColumnWidths = "120; 40 pt"

'Assign Access data to an array of 2 columns and 500 rows
CategoryArray(99, 2) = rst1.GetRows(500)
ctl.Column() = CategoryArray(99, 2)


'Retrieve Category info from table
Set rst1 = db.OpenRecordset("Work4number")
Set ctl =
Item.GetInspector.ModifiedFormPages("Message").Controls("cboClient")
ctl.ColumnCount = 2
ctl.ColumnWidths = "120; 40 pt"

'Assign Access data to an array of 2 columns and 500 rows
CategoryArray(99, 2) = rst1.GetRows(500)
ctl.Column() = CategoryArray(99, 2)
'-=-=-=-=-=-=-

Dim Obe
Dim MyDB
Dim Rst
Dim Rsm
Dim Counter, CounterStart
Dim RequestNum
Dim RqBox
Dim MyAttachments

'On error resume next
Set Dbe = Application.CreateObject("DAO.DBEngine.36")
If Err.Number <> 0 Then
Msg Err.Description & "--- Some functions may not work correctly" _
& Chr(13) & "Please make sure that Dao 3.6 is installed on this
machine"
Exit Function
End If

'Check to see if this is from scratch
Set MyDB =
Dbe.Workspaces(0).OpenDatabase("\\tabsnas\database$\edgar\newcigars\newcigars3.mdb")
Set Rst = MyDB.OpenRecordset("dbtask")

set nms=application.getnamespace("mapi")
vrUser=nms.currentuser
'msgbox "User " & vUser

If UserProperties.Find("jobnum").Value = 0 Then
CounterStart = 1
Counter = Rst.RecordCount + CounterStart
set nms= application.getnamespace("mapi")
vrUser=nms.currentuser
UserProperties.Find("jobnum").Value = Counter
UserProperties.Find("Reqby").Value = vrUser
UserProperties.Find("txtstatus").Value = "Submit"
UserProperties.Find("Jobtype").Value = "PC Conversion"

Rst.AddNew
Rst("Tasknum") = Counter
Rst("txtstatus") = "Submit"
Rst("jobtype") = "PC Conversion"
Rst.fields(2).value=vrUser
Rst.Update
Rst.Close
MyDB.Close

Elseif Item.Sendername = vrUser then
If Msgbox("Is this a resubmit job?", vbYesNo, "Initializing") = vbYes then
CounterStart = 1
Counter = Rst.RecordCount + CounterStart
set nms= application.getnamespace("mapi")
vrUser=nms.currentuser

'This is where i think the code should go. Right after I check for
resubmit......


UserProperties.Find("jobnum").Value = Counter
UserProperties.Find("Reqby").Value = vrUser
UserProperties.Find("txtstatus").Value = "Submit"
UserProperties.Find("Jobtype").Value = "PC Conversion"

Rst.AddNew
Rst("Tasknum") = Counter
Rst("txtstatus") = "Submit"
Rst("jobtype") = "PC Conversion"
Rst.fields(2).value=vrUser
Rst.Update
Rst.Close
MyDB.Close
Else
Rst.close
Mydb.Close
Exit Function
End if

Else
RequestNum =UserProperties.Find("jobnum").Value
Set Rst = MyDB.OpenRecordset("select * from dbtask where tasknum = " &
RequestNum)
UserProperties.Find("txtstatus").Value = rst.Fields(4).Value
'UserProperties.Find("Operator").Value = rst.Fields(3).Value

'msgbox "Inside Update"

If UserProperties.Find("txtstatus").Value = "Work in progress" then
msgbox"This job has been started already"
End if

If UserProperties.Find("txtstatus").Value = "Finished" then
msgbox"This job has been completed already"
End if

rst.close
mydb.close
End If
End Function
'-=-=-=-=-=-=-=-

Function Item_Send()
update1
msgbox "Data has been Saved to Database"
End Function
'-=-=-=-=-=-=-=-

 

[Rob Oldfield]

I'm assuming that your code is Outlook VB. If that's the case then you're
going to want to repost this message in an Outlook newsgroup. It'll have
the word 'Outlook' in the name....