I have a bit of visual basic code to convert some text files into word documents. It worked fine in Word2003 but does not work in Word2007. The error message is "Run-time error '5111': This command is not available on this platform".
The line it is stopping on is "Set fs = Application.FileSearch".
The entire macro is below in case you need it.
Regards
Dave
---------------------------------------------------------------------------------------
Sub Cav0001()
'
' Cav0001 Macro
'
'
Set fs = Application.FileSearch
With fs
.LookIn = "Y:\Address Extracts"
.FileName = "ar***."
Dim Msg, Style, Title, Response
Title = "Cavalier Carpets - Customer Details Convertor ©1999"
If .Execute > 0 Then
Msg = "Convert " & .FoundFiles.Count & _
" file(s) Into Word."
Style = vbYesNo + vbDefaultButton1 ' Define buttons.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
Kill "Y:\Address Extracts\***.doc"
For i = 1 To .FoundFiles.Count
Dim Object, Source, Str1, Path
Source = .FoundFiles(i)
Documents.Open FileName:=Source
Selection.MoveUp UNIT:=wdScreen, Count:=1
Selection.MoveUp UNIT:=wdLine, Count:=1
Selection.TypeParagraph
Selection.MoveUp UNIT:=wdLine, Count:=1
Selection.WholeStory
Selection.Cut
Documents.Close SaveChanges:=wdDoNotSaveChanges
Str1 = Mid(Source, 23, 3)
Path = "Y:\Address Extracts\"
Object = Path & Str1 & ".doc"
Set newDoc = Documents.Add
With newDoc
.SaveAs FileName:=Object
End With
Documents.Open FileName:=Object
Selection.Paste
Selection.MoveUp UNIT:=wdScreen, Count:=1
Selection.WholeStory
Selection.Font.Size = 12
Selection.Font.Name = "Times New Roman"
Selection.MoveUp UNIT:=wdScreen, Count:=1
Open Source For Input As #1 ' Open file for input.
Dim Counter, Page
Counter = 0
Page = 0
Do While Not EOF(1) ' Check for end of file.
Line Input #1, InputData ' Read line of data.
Counter = Counter + 1 ' Increment Counter.
If Counter = 9 Then ' If condition is True.
Selection.MoveDown UNIT:=wdLine, Count:=9
Selection.TypeText Text:= _
"------------------------------------------------------------"
Selection.TypeText Text:="------"
Counter = 0
Page = Page + 1
End If
If Page = 5 Then ' If condition is True.
Selection.InsertBreak Type:=wdPageBreak
Page = 0
End If
Loop
Documents.Close SaveChanges:=wdSaveChanges
Close #1
Next i
Kill "Y:\Address Extracts\ar***."
Style = vbDefaultButton2
Msg = "Conversion Was Successfully Completed!"
Response = MsgBox(Msg, Style, Title)
End If
Else
Style = vbDefaultButton2
Msg = " No Files To Convert!"
Response = MsgBox(Msg, Style, Title)
End If
End With
End Sub
---------------------------------------------------------------------------------------
The line it is stopping on is "Set fs = Application.FileSearch".
The entire macro is below in case you need it.
Regards
Dave
---------------------------------------------------------------------------------------
Sub Cav0001()
'
' Cav0001 Macro
'
'
Set fs = Application.FileSearch
With fs
.LookIn = "Y:\Address Extracts"
.FileName = "ar***."
Dim Msg, Style, Title, Response
Title = "Cavalier Carpets - Customer Details Convertor ©1999"
If .Execute > 0 Then
Msg = "Convert " & .FoundFiles.Count & _
" file(s) Into Word."
Style = vbYesNo + vbDefaultButton1 ' Define buttons.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
Kill "Y:\Address Extracts\***.doc"
For i = 1 To .FoundFiles.Count
Dim Object, Source, Str1, Path
Source = .FoundFiles(i)
Documents.Open FileName:=Source
Selection.MoveUp UNIT:=wdScreen, Count:=1
Selection.MoveUp UNIT:=wdLine, Count:=1
Selection.TypeParagraph
Selection.MoveUp UNIT:=wdLine, Count:=1
Selection.WholeStory
Selection.Cut
Documents.Close SaveChanges:=wdDoNotSaveChanges
Str1 = Mid(Source, 23, 3)
Path = "Y:\Address Extracts\"
Object = Path & Str1 & ".doc"
Set newDoc = Documents.Add
With newDoc
.SaveAs FileName:=Object
End With
Documents.Open FileName:=Object
Selection.Paste
Selection.MoveUp UNIT:=wdScreen, Count:=1
Selection.WholeStory
Selection.Font.Size = 12
Selection.Font.Name = "Times New Roman"
Selection.MoveUp UNIT:=wdScreen, Count:=1
Open Source For Input As #1 ' Open file for input.
Dim Counter, Page
Counter = 0
Page = 0
Do While Not EOF(1) ' Check for end of file.
Line Input #1, InputData ' Read line of data.
Counter = Counter + 1 ' Increment Counter.
If Counter = 9 Then ' If condition is True.
Selection.MoveDown UNIT:=wdLine, Count:=9
Selection.TypeText Text:= _
"------------------------------------------------------------"
Selection.TypeText Text:="------"
Counter = 0
Page = Page + 1
End If
If Page = 5 Then ' If condition is True.
Selection.InsertBreak Type:=wdPageBreak
Page = 0
End If
Loop
Documents.Close SaveChanges:=wdSaveChanges
Close #1
Next i
Kill "Y:\Address Extracts\ar***."
Style = vbDefaultButton2
Msg = "Conversion Was Successfully Completed!"
Response = MsgBox(Msg, Style, Title)
End If
Else
Style = vbDefaultButton2
Msg = " No Files To Convert!"
Response = MsgBox(Msg, Style, Title)
End If
End With
End Sub
---------------------------------------------------------------------------------------