[csit17]

Hi All

I'm having a bit of trouble with a macro I have. I am trying to copy information from cells within Excel 2003 and paste it into a template I have created in Word 2003, I then want that Word document to be saved.

Sub Testcreate()
Dim wrdApp As Word.Application, MItem As Object, OutlookApp As Object
Dim Data As Range
Dim ParcelNumber As String, ClaimNumber As String, Contents As String, ConValue As String
Dim LastScan As String, Comments As String, PostCode As String, SaveAsName As String
Dim wrdDoc As Word.Document
Dim i As Integer
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Add
' or
' Set wrdDoc = wrdApp.Documents.Open("T:\Customer Retention\Customer Claims\Claims Investigator Evidence Folder\Mark Callaghan\Claim Authorisation Form.doc")
' Information from worksheet
Set Data = Sheets("Export Sheet").Range("A1")

' Assign current data to variables
ParcelNumber = Data.Cells.Offset(i, 0).Range("A1").Value
ClaimNumber = Data.Cells.Offset(i, 1).Range("A1").Value
Contents = Data.Cells.Offset(i, 2).Range("A1").Value
ConValue = Format(Data.Cells.Offset(i, 3).Range("A1").Value, "£#,##0.00")
PostCode = Data.Cells.Offset(i, 5).Range("A1").Value
Comments = Data.Cells.Offset(i, 6).Range("A1").Value
LastScan = Data.Cells.Offset(i, 8).Range("A1").Value

' Select and Copy data into relevent cell within Word
With wrdDoc
Selection.MoveDown Unit:=wdLine, Count:=3
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="today"
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeText Text:=ClaimNumber
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeText Text:=ParcelNumber
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeText Text:=Contents
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeText Text:=ConValue
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeText Text:=LastScan
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeText Text:=Comments
If Dir("T:\Customer Retention\Customer Claims\Claims Investigator Evidence Folder\Mark Callaghan\Claim " & ClaimNumber & ".doc") <> "" Then
Kill "T:\Customer Retention\Customer Claims\Claims Investigator Evidence Folder\Mark Callaghan\Claim " & ClaimNumber & ".doc"
End If
.SaveAs ("T:\Customer Retention\Customer Claims\Claims Investigator Evidence Folder\Mark Callaghan\Claim " & ClaimNumber & ".doc")
.Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub

Hope you help, your time is much appreciated

Regards
Mark