Prev: Message Box
Next: Unable to permanently delete the MS Word custom toolbar
From: RyGuy on 28 Mar 2010 00:32
Thanks Doug and Jay! Both macros worked excellent!!
Ryan--


"Jay Freedman" wrote:

> Hi Ryan,
>
> The Dir$ method works without any need for a FileSystemObject. Try
> this version:
>
> Sub Foo()
> Dim i As Long
> Dim MyName As String, MyPath As String
> Application.ScreenUpdating = False
> Documents.Add
>
> MyPath = "C:\temp\" ' <= change this as necessary
>
> MyName = Dir$(MyPath & "*.doc") ' not *.* if you just want doc files
>
> Do While MyName <> ""
> If InStr(MyName, "~") = 0 Then
> Selection.InsertFile _
> FileName:="""" & MyPath & MyName & """", _
> ConfirmConversions:=False, Link:=False, _
> Attachment:=False
> Selection.InsertBreak Type:=wdPageBreak
> End If
>
> MyName = Dir ' gets the next doc file in the directory
> Loop
>
> End Sub
>
>
> If you do want to use a FileSystemObject instead (*not* in addition),
> then the first thing you need to do is (in the VBA editor) go to the
> Tools > References dialog and put a check mark next to "Microsoft
> Scripting Runtime". That's the library that contains the code for the
> FileSystemObject. Then you need to learn how to use the FSO and its
> methods properly. Here's the equivalent macro:
>
> Sub Foo2()
>
> ' Uses File System Object
> ' Need to have reference to Microsoft Scripting Runtime
>
> On Error GoTo Show_Err
> Dim oFS As FileSystemObject
> Dim MyName As String, MyPath As String
> Dim MyFolder As Folder, MyFile As File
>
> Application.ScreenUpdating = False
> Documents.Add
>
> Set oFS = New FileSystemObject
> MyPath = "C:\temp\" ' <= change this as necessary
>
> Set MyFolder = oFS.GetFolder(MyPath)
> For Each MyFile In MyFolder.Files
> If (InStr(MyFile.Name, ".doc") = Len(MyFile.Name) - 3) _
> And (InStr(MyFile.Name, "~") = 0) Then
> Selection.InsertFile _
> FileName:="""" & MyPath & MyFile.Name & """", _
> ConfirmConversions:=False, Link:=False, _
> Attachment:=False
> Selection.InsertBreak Type:=wdPageBreak
> End If
> Next
>
> If Not oFS Is Nothing Then Set oFS = Nothing
>
> Show_Err:
>
> If Err <> 0 Then
> MsgBox Err.Number & " - " & Err.Description
> Err.Clear
> End If
> End Sub
>
> --
> Regards,
> Jay Freedman
> Microsoft Word MVP FAQ: http://word.mvps.org
> Email cannot be acknowledged; please post all follow-ups to the
> newsgroup so all may benefit.
>
>
> On Sat, 27 Mar 2010 14:42:01 -0700, ryguy7272
> <ryguy7272(a)discussions.microsoft.com> wrote:
>
> >Thanks Doug. I tried the code below:
> >
> >Sub Foo()
> >Dim i As Long
> >Application.ScreenUpdating = False
> >Documents.Add
> >
> >With FileSystemObject
> >MyName = Dir$(MyPath & "*.*")
> >
> > Do While MyName <> ""
> > .SearchSubFolders = False
> > .FileName = "*.doc"
> > .Execute
> > 'Selection.InsertAfter MyName & vbCr
> > MyName = Dir
> > Loop
> >
> > For i = 1 To .FoundFiles.Count
> > If InStr(.FoundFiles(i), "~") = 0 Then
> > Selection.InsertFile FileName:=(.FoundFiles(i)), _
> > ConfirmConversions:=False, Link:=False, Attachment:=False
> > Selection.InsertBreak Type:=wdPageBreak
> > End If
> > Next i
> >
> >End With
> >End Sub
> >
> >Now I getting a Run-Time Error 424
> >Object Required
> >
> >Error occurs here:
> >.SearchSubFolders = False
> >
> >Any thoughts on how to resolve this?
> >
> >Thanks,
> >Ryan---
> >
> >--
> >Ryan---
> >If this information was helpful, please indicate this by clicking ''Yes''.
> >
> >
> >"Doug Robbins - Word MVP" wrote:
> >
> >> You will need to use the Dir$ method as done in the article
> >> http://www.word.mvps.org/FAQs/MacrosVBA/InsertFileNames.htm
> >>
> >> --
> >> Hope this helps.
> >>
> >> Please reply to the newsgroup unless you wish to avail yourself of my
> >> services on a paid consulting basis.
> >>
> >> Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
> >>
> >> "RyGuy" <RyGuy(a)discussions.microsoft.com> wrote in message
> >> news:6F9BF86D-CD9F-42F9-8EED-1C454890B73E(a)microsoft.com...
> >> > This code used to work in my Word 2002; not working in 2007:
> >> > Sub Foo()
> >> > Dim i As Long
> >> > Application.ScreenUpdating = False
> >> > Documents.Add
> >> > With Application.FileSearch
> >> > 'Search in foldername
> >> > .LookIn = "C:\Documents and Settings\Excel\Desktop\Word Files\"
> >> > .SearchSubFolders = False
> >> > .FileName = "*.doc"
> >> > .Execute
> >> > For i = 1 To .FoundFiles.Count
> >> > If InStr(.FoundFiles(i), "~") = 0 Then
> >> > Selection.InsertFile FileName:=(.FoundFiles(i)), _
> >> > ConfirmConversions:=False, Link:=False, Attachment:=False
> >> > Selection.InsertBreak Type:=wdPageBreak
> >> > End If
> >> > Next i
> >> > End With
> >> > End Sub
> >> >
> >> > The error is: Run-Time error 5111
> >> > This command is not available on this platform.
> >> >
> >> > This is the line that errors out:
> >> > With Application.FileSearch
> >> >
> .
>
First  |  Prev  | 
Pages: 1 2
Prev: Message Box
Next: Unable to permanently delete the MS Word custom toolbar