looping problem

Hi everyone...I am having a problem with code I've put together. I'm trying to get this to loop through every Incident Report in my mail box, (which it does), copy and paste that from an Excel file into a Word doc (which it does) and save the word doc on my desktop with a different name for each Incident Report in my mail box (which it doesn't). It just opens up a new word doc for each Incident Report, it pastes the correct data into the doc, but it doesn't save the doc, it just leaves it open, and then opens a new one...etc until I have a bunch of open Word docs open.... I know I'm messing my loop up, but I've tried to move this part:


'Saves document
objWdDoc.SaveAs Filename:="C:\Documents and Settings\dmorri18\Desktop\IncidentReport" & myDte & ".doc"

all over in my code... and I can't seem to get it right...Can anyone out there tell me if that should go before my if...after my if...before my next...etch....

Here is my complete code:


Sub imPortInbox()

Dim objWdApp As Word.Application
Dim objWdDoc As Word.Document
Dim objwdRange As Word.Range
Dim myDte As String
Dim OutApp As Object 'Outlook.Application
Dim NmSpace As Object 'Outlook.NameSpace
Dim Inbox As Object 'Outlook.MAPIFolder
Dim MItem As Object 'Outlook.MailItem

myDte = Range("myDte").Value
myDte = Format(myDte, "mm-dd-yy hh:mm")

Set olMAPI = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Set Inbox = olMAPI.GetDefaultFolder(6)
'// In case of UNDELIVERABLES
On Error Resume Next
For Each MItem In Inbox.Items
DoEvents
'// Note Only looking for Incident Reports!
If Left(MItem.Subject, 16) = "INCIDENT REPORT:" Then
Sheets("Sheet1").Activate

Range("I3") = MItem.UserProperties("IncidentDateTime").Value
Range("B3") = MItem.UserProperties("IncidentDept").Value
Range("B5") = MItem.UserProperties("IncidentType").Value
Range("B7") = MItem.UserProperties("IncidentDescription").Value
Range("B9") = MItem.UserProperties("IncidentAffected").Value
Range("C11") = MItem.UserProperties("irAHT").Value
Range("C12") = MItem.UserProperties("irNCA").Value
Range("C13") = MItem.UserProperties("irOCC").Value
Range("C14") = MItem.UserProperties("irOCW").Value
Range("E11") = MItem.UserProperties("irASA").Value
Range("E12") = MItem.UserProperties("irNCH").Value
Range("E13") = MItem.UserProperties("irFD").Value
Range("E14") = MItem.UserProperties("irACC").Value
Range("G11") = MItem.UserProperties("irATA").Value
Range("G12") = MItem.UserProperties("irNCO").Value
Range("G13") = MItem.UserProperties("irQ").Value
Range("G14") = MItem.UserProperties("irSL").Value
Range("C17") = MItem.SenderName

Module2.clnData
Module2.getTime
Range("A3:J17").Copy
'Create instance of Word Application
Set objWdApp = New Word.Application
Set objWdDoc = objWdApp.Documents.Open(Filename:="C:\Documents and Settings\dmorri18\Desktop\CreateLetter\IncidentReport.dot")
'Set the range equal to the entire word doc
Set objwdRange = objWdDoc.Range
'pastes data
objwdRange.Paste
'Make word visible
objWdApp.Visible = True
'Saves document
objWdDoc.SaveAs Filename:="C:\Documents and Settings\dmorri18\Desktop\IncidentReport" & myDte & ".doc"

End If

N: Next MItem

Set MItem = Nothing
Set Inbox = Nothing
Set NmSpace = Nothing
Set OutApp = Nothing
Set Attach = Nothing

objWdApp.Quit

Set objwdRange = Nothing
Set objWdDoc = Nothing
Set objWdApp = Nothing

End Sub

Thanks,

Dave M...

P.S. Feel free to clean it up...you wont hurt my feelings....

Couple of quick points:

You are creating a new instance of word every time you want to create a new document, but you only have one .Quit. Why not take the creation outside of your loop?

On the assumption that the creating of the Word instance is now outside of your loop, I would add a .Close line after your .SaveAs line.

I am quite busy a the minute, so have not been able to have a better look, but the above might give you a nudge.

TJ

Thanks for the reply...I've altered the code as you've suggested...(I think). Now it does open only 1 instance of the Word.App. and does all the code except the save part...For some reason it wont save the document. There is data in the Word doc, I've stopped the code before it could close it, but it still doesn't want to save....:-(

Thanks for your help, and below is my altered code:


Sub imPortInbox()

Dim objWdApp As Word.Application
Dim objWdDoc As Word.Document
Dim objwdRange As Word.Range
Dim myDte As String
Dim OutApp As Object 'Outlook.Application
Dim NmSpace As Object 'Outlook.NameSpace
Dim Inbox As Object 'Outlook.MAPIFolder
Dim MItem As Object 'Outlook.MailItem

myDte = Range("myDte").Value
myDte = Format(myDte, "mm-dd-yy hh:mm")

Set olMAPI = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Set Inbox = olMAPI.GetDefaultFolder(6)
'Create instance of Word Application
Set objWdApp = New Word.Application
'// In case of UNDELIVERABLES
On Error Resume Next
For Each MItem In Inbox.Items
DoEvents
'// Note Only looking for Incident Reports!
If Left(MItem.Subject, 16) = "INCIDENT REPORT:" Then
Sheets("Sheet1").Activate

Range("I3") = MItem.UserProperties("IncidentDateTime").Value
Range("B3") = MItem.UserProperties("IncidentDept").Value

Module2.clnData
Module2.getTime
Range("A3:J17").Copy

Set objWdDoc = objWdApp.Documents.Open(Filename:="C:\Documents and Settings\dmorri18\Desktop\CreateLetter\IncidentReport.dot")
'Set the range equal to the entire word doc
Set objwdRange = objWdDoc.Range
'pastes data
objwdRange.Paste
'Make word visible
objWdApp.Visible = True
'Saves document
objWdDoc.SaveAs Filename:="C:\Documents and Settings\dmorri18\Desktop\IncidentReport" & myDte & ".doc"
objWdDoc.Close

End If

N: Next MItem

Set MItem = Nothing
Set Inbox = Nothing
Set NmSpace = Nothing
Set OutApp = Nothing
Set Attach = Nothing

objWdApp.Quit

Set objwdRange = Nothing
Set objWdDoc = Nothing
Set objWdApp = Nothing

End Sub

I've omitted unecessary parts to try and keep it brief...

Thanks again,

Dave M.

Could be something as simple as a problem with the file name... set the path through a string, and make sure it looks ok.
Dim filepath As String
filepath = "C:\Documents and Settings\dmorri18\Desktop\IncidentReport" & myDte & ".doc"
'stop code here and check value of filepath
objWdDoc.SaveAs Filename:=filepath

Heh...umm....doh! Sorry but it was actually this line:


myDte = Format(myDte, "mm-dd-yy hh:mm")

that was causing the problems.... this little bugger ":" was the culprit! Of course if you use a : in a filename, it makes the file name invalid!!!

I just switched the line to:


myDte = Format(myDte, "mm-dd-yy HHmm")

and that solved my problems...except for the suggestions that were made above...so my working code is as follows:


Sub imPortInbox()

Dim objWdApp As Word.Application
Dim objWdDoc As Word.Document
Dim objwdRange As Word.Range
Dim myDte As String

Dim OutApp As Object 'Outlook.Application
Dim NmSpace As Object 'Outlook.NameSpace
Dim Inbox As Object 'Outlook.MAPIFolder
Dim MItem As Object 'Outlook.MailItem

myDte = Range("myDte").Value
myDte = Format(myDte, "mm-dd-yy HHmm")

'Create instance of Word Application
Set objWdApp = New Word.Application
Set olMAPI = GetObject("", "Outlook.Application").GetNamespace("MAPI")
objWdApp.Visible = True
Set Inbox = olMAPI.GetDefaultFolder(6)
'// In case of UNDELIVERABLES
On Error Resume Next
For Each MItem In Inbox.Items
DoEvents
'// Note Only looking for Incident Reports!
If Left(MItem.Subject, 16) = "INCIDENT REPORT:" Then
Sheets("Sheet1").Activate

Range("I3") = MItem.UserProperties("IncidentDateTime").Value
Range("B3") = MItem.UserProperties("IncidentDept").Value
Range("B5") = MItem.UserProperties("IncidentType").Value
Range("B7") = MItem.UserProperties("IncidentDescription").Value
Range("B9") = MItem.UserProperties("IncidentAffected").Value
Range("C11") = MItem.UserProperties("irAHT").Value
Range("C12") = MItem.UserProperties("irNCA").Value
Range("C13") = MItem.UserProperties("irOCC").Value
Range("C14") = MItem.UserProperties("irOCW").Value
Range("E11") = MItem.UserProperties("irASA").Value
Range("E12") = MItem.UserProperties("irNCH").Value
Range("E13") = MItem.UserProperties("irFD").Value
Range("E14") = MItem.UserProperties("irACC").Value
Range("G11") = MItem.UserProperties("irATA").Value
Range("G12") = MItem.UserProperties("irNCO").Value
Range("G13") = MItem.UserProperties("irQ").Value
Range("G14") = MItem.UserProperties("irSL").Value
Range("C17") = MItem.SenderName

myDte = Range("myDte").Value
myDte = Format(myDte, "mm-dd-yy HHmm")

Set objWdDoc = objWdApp.Documents.Open(Filename:="C:\Documents and Settings\dmorri18\Desktop\CreateLetter\IncidentReport.dot")
Set objwdRange = objWdDoc.Range

Module2.clnData
Module2.getTime
Range("A3:J17").Copy

objwdRange.Paste

objWdDoc.SaveAs Filename:="C:\Documents and Settings\dmorri18\Desktop\IncidentReport" & myDte & ".doc"
objWdDoc.Close
End If

N: Next MItem

objWdApp.Quit

Set MItem = Nothing
Set Inbox = Nothing
Set NmSpace = Nothing
Set OutApp = Nothing
Set Attach = Nothing

Set objwdRange = Nothing
Set objWdDoc = Nothing
Set objWdApp = Nothing

End Sub

Thanks for all the help!!!

Dave M