Solved: Word to Excel Copy
Hi,
I got the macro in word which will open each rtf file from the specified folder and copy the fourth line and paste it in one excel file. The data pasted in excel file is rtf File name in column A and the fourth line from each word file in column B.
It works fine except the data in excel file column B contains the junk character (small ? in square box). Also if i copy the column B n paste in Notepad, the whole text is in between double quots and junk character is replace by just a box.
I do not want any double quots or junk characters in data copied to excel file.
Please help. Thanks in advance.
The macro is as follow:
[vba]
Sub W2E()
Dim fname As String
Dim PathToUse As String
Dim Target As Excel.Workbook
Dim Source As Document
Dim fd As FileDialog
Dim drange As Range
Dim strText As String
Dim i As Long, j As Long
Dim oXL As Excel.Application
Dim tSheet As Excel.Worksheet
Dim ExcelWasNotRunning As Boolean
'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
'On Error GoTo Err_Handler
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select the folder containing the files."
If .Show = -1 Then
PathToUse = .SelectedItems(1) & "\"
Else
End If
End With
Set fd = Nothing
oXL.Visible = True
'Open the workbook
Set Target = oXL.Workbooks.Add
Set tSheet = Target.Sheets(1)
With tSheet
.Range("A1") = "File Name"
.Range("B1") = "Doctor Name"
End With
If Len(PathToUse) = 0 Then
Exit Sub
End If
fname = Dir$(PathToUse & "*.rtf")
j = 1
While fname <> ""
Set Source = Documents.Open(PathToUse & fname)
With Source
j = j + 1
tSheet.Range("A" & j) = fname
strText = .Paragraphs(4).Range.Text
tSheet.Range("B" & j) = strText
End With
Source.Close wdDoNotSaveChanges
fname = Dir$()
Wend
tSheet.Cells.VerticalAlignment = xlTop
Set drange = Nothing
Set tSheet = Nothing
Set Target = Nothing
Set oXL = Nothing
Exit Sub
Err_Handler:
MsgBox Target & " caused a problem. " & Err.Description, vbCritical_
If ExcelWasNotRunning Then
oXL.Quit
End If
End Sub
[/vba]
