?
Solved

Export IE Favorite URLfolder to excel

Posted on 2009-04-29
14
Medium Priority
?
385 Views
Last Modified: 2013-12-08
Hi, I have a folder of favorite URLs in IE6.

I tried File-Export but when I try to open the bookmark file in Word or Excel I get a bunch of code. All I want are clean URLs.

How can I do this, thanks!

-Tom
0
Comment
Question by:tomfolinsbee
  • 7
  • 7
14 Comments
 
LVL 21

Expert Comment

by:Alan
ID: 24267134
Hi,

Given that you have a folder of favourite URLs, this will list them in the activesheet.

Make sure you don't have anything in there already, else it will be overwritten!

Does that work for you?

Alan.

Sub GetURLs()
 
 
    With Application.FileSearch
    
        .LookIn = InputBox("Enter the path to search (e.g. Without the quotes: 'D:\Temp'", "Folder?")
        .FileType = msoFileTypeAllFiles
        .SearchSubFolders = True
        .Execute
    
    End With
    
    
    For i = 1 To Application.FileSearch.FoundFiles.Count
       
        ActiveSheet.Range("A" & i).Value = Application.FileSearch.FoundFiles.Item(i)
    
    Next i
 
End Sub

Open in new window

0
 
LVL 21

Expert Comment

by:Alan
ID: 24267140
PS:  It will also list sub-folder shortcut URLs.  If you don't want that, change the 'SearchSubFolders' to be FALSE.
0
 

Author Comment

by:tomfolinsbee
ID: 24267295
Thanks. I get a compile error on C:

Sub GetURLs()
 
 
    With Application.FileSearch
   
        .LookIn = InputBox(C:\Documents and Settings\user\Favorites\folder name)
        .FileType = msoFileTypeAllFiles
        .SearchSubFolders = True
        .Execute
   
    End With
   
   
    For i = 1 To Application.FileSearch.FoundFiles.Count
       
        ActiveSheet.Range("A" & i).Value = Application.FileSearch.FoundFiles.Item(i)
   
    Next i
 
End Sub
0
[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

 
LVL 21

Accepted Solution

by:
Alan earned 2000 total points
ID: 24267301
PPS:  If you are using Excel 2007, then that won't work as the FileSearch object was removed from the object model (no idea why!).

If so, you'll need to do something like this instead:

+-+-+-+-+-+-+-+-+-+-+-+-+-+-+

Sub GetURLs()
   
    Set fs = New FileSearch
   
    With fs
   
        .LookIn = InputBox("Enter the path to search (e.g. Without the quotes: 'D:\Temp'", "Folder?")
        .SearchSubFolders = True
        .Execute
   
    End With
   
   
   
    For i = 1 To fs.FoundFiles.Count
       
        If Right(fs.FoundFiles.Item(i), 4) = ".url" Then
       
            Workbooks.OpenText (fs.FoundFiles.Item(i))
       
            Set wb = ActiveWorkbook
   
            ThisWorkbook.ActiveSheet.Range("A" & i).Value = Mid(wb.Worksheets(1).Range("A2").Value, 9, 999)
       
            wb.Close False
   
        End If
   
    Next i

End Sub

+-+-+-+-+-+-+-+-+-+-+-+-+-+-+

Then also add the attached class module and call it FileSearch.

Thanks to Chris Rae for that.

Alan.


Option Explicit
 
' Are we debugging - 3=full, 2=some 1=a little, 0=no
#Const SHOWDEBUG = 0
 
' -------------------------------------------------------------------------
' Object model:
'
' Methods:
'
' Execute - actually run search (returns Boolean which is always true
'           unless deletes were requested which failed). If deletes
'           were requested, the list returned from the actual search
'           has no members.
' NewSearch - clear it
'
' Properties:
'
' Lookin (string) - directory to search from
' Sort (boolean) - whether or not to sort results
' IncludeDirs (boolean) - include directories with results (not just files)
' FoundFiles (collection) - the results
' SearchSubFolders (boolean) - recurse?
' DeleteFiles (boolean) - delete files as search progresses
' DeleteFolders (boolean) - delete folders as search progresses
' -------------------------------------------------------------------------
 
' The directory to look in. Set using the procedures. CLR, 13/5/99.
Private priLookIn As String
 
' The directory to copy to. Set using the procedures. CLR, 13/5/99.
Private priCopyTo As String
 
' Whether or not to sort the results. CLR, 13/5/99.
Public Sort As Boolean
 
' Whether or not to include directories in the results. CLR, 17/5/99.
Public IncludeDirs As Boolean
 
' The filename (well, spec) to look for. CLR, 17/5/99.
Public FileName As String
 
' Whether or not to search through subdirectories. CLR, 17/5/99.
Public SearchSubFolders As Boolean
 
' The list of results.
Public FoundFiles As New Collection
 
' Whether or not to delete the files. CLR, 5/7/99.
Public DeleteFiles As Boolean
 
' Whether or not to delete the directories. CLR, 5/7/99.
Public DeleteFolders As Boolean
 
' Whether everything was in fact deleted okay.
Private DeletedOkay As Boolean
 
Property Let LookIn(ToDir As String)
    ' Set the directory to look in. Tidies up
    ' trailing slashes. CLR, 5/7/99.
 
    ' Giving a base directory with a trailing slash doesn't work.
    ' This poses a little of a problem because you can't pass something
    ' like "C:\" to it. So we just chop the slash. This, however, means
    ' that you can't give it "C:" to mean the current working directory
    ' on drive C - tough. You shouldn't write code like that anyways.
    If Right(ToDir, 1) = "\" Then
        ToDir = Left(ToDir, Len(ToDir) - 1)
        SDebug "Cutting trailing slash on directory name", 2
    End If
 
    priLookIn = ToDir
End Property
Property Get LookIn() As String
    ' Get the directory to look in. CLR, 5/7/99.
    LookIn = priLookIn
End Property
 
Property Let CopyTo(ToDir As String)
    ' Set the directory to copy to. Tidies up
    ' trailing slashes. CLR, 5/7/99.
    
    If Right(ToDir, 1) = "\" Then
        ToDir = Left(ToDir, Len(ToDir) - 1)
        SDebug "Cutting trailing slash on directory name", 2
    End If
    
    priCopyTo = ToDir
End Property
 
Property Get CopyTo() As String
    ' Get the directory to copy to. CLR, 5/7/99.
    CopyTo = priCopyTo
End Property
 
' The routine to display debugging information. 24/5/99.
Private Sub SDebug(DBInfo As String, DebugLevel As Integer)
    #If SHOWDEBUG = 1 Then
        If DebugLevel <= 1 Then Debug.Print "(CLRFileSearch) L" & DebugLevel & " -> " & DBInfo
    #ElseIf SHOWDEBUG = 2 Then
        If DebugLevel <= 2 Then Debug.Print "(CLRFileSearch) L" & DebugLevel & " -> " & DBInfo
    #ElseIf SHOWDEBUG = 3 Then
        If DebugLevel <= 3 Then Debug.Print "(CLRFileSearch) L" & DebugLevel & " -> " & DBInfo
    #End If
End Sub
 
' Run when an instance of the class is started - just
' runs the clear procedure. CLR, 14/5/99.
Private Sub Class_Initialize()
    SDebug "New class instance", 1
    NewSearch
End Sub
 
' Clear the search. CLR, 17/5/99.
Public Sub NewSearch()
    LookIn = "c:\"
    Sort = False
    IncludeDirs = False
    SearchSubFolders = True
    SDebug "Cleared search criteria", 1
    DeleteFiles = False
    DeleteFolders = False
    CopyTo = ""
End Sub
 
' Run when the instance of the class is closed. I'm not
' 100% sure about this part.
Private Sub Class_Terminate()
    ' Kill off our results list.
    Set FoundFiles = Nothing
    SDebug "Class terminated, memory released", 1
End Sub
 
' The main run procedure. CLR, 13/5/99.
Public Function Execute() As Boolean
    ' Start recursing from the top dir.
    SDebug "Executing search", 1
    DeletedOkay = True
    RunDown priLookIn
    Execute = DeletedOkay
End Function
 
' The recursive bit. Stolen from various other programs
' I wrote with similar ends in mind. CLR, 13/5/99.
Private Sub RunDown(BaseDirectory As String)
    ' All of the files which match in the directory
    Dim FilesHere() As String
    ' And the directories
    Dim DirsHere() As String
       
    ' The count of how many files there are
    Dim FileCount As Integer
    ' And the directories
    Dim DirCount As Integer
 
    ' The string each filename is temporarily stored in
    Dim ThisFile As String
    ' The loop to go through each entry and perform what
    ' is necessary
    Dim AddItem As Integer
    ' The loop to recurse through each directory entry
    Dim RecurseDirs As Integer
    
    ' The flag to say whether any actual changes were made
    ' during the bubblesort
    Dim AnyChanges As Boolean
    ' The sort loop
    Dim BubbleSort As Integer
    ' The temporary swapping variable
    Dim SwapFH As String
    ' Whether or not the file is
    ' a directory
    Dim ItIsDir As Integer
    
    ' If a copy failed then don't bother trying the delete
    ' in case we lose stuff.
    Dim CopyFailed As Boolean
    
    SDebug "Searching: """ & BaseDirectory & """", 2
    
    ' Find the directories in here
    DirCount = 0
    ThisFile = Dir(BaseDirectory & "\*.*", vbDirectory)
    While ThisFile <> ""
        If ThisFile <> ".." And ThisFile <> "." Then
            ' This trap will catch if the file doesn't
            ' exist at all (occasional problem with
            ' NetWare volumes)
            On Error GoTo FileNotThere
            ' Check if it's a directory
            ItIsDir = GetAttr(BaseDirectory & "\" & ThisFile)
            If (ItIsDir And vbDirectory) Then
                SDebug "Adding dir: " & ThisFile, 3
                DirCount = DirCount + 1
                ReDim Preserve DirsHere(1 To DirCount)
                DirsHere(DirCount) = ThisFile
            End If
            GoTo SkipFNT
FileNotThere:
            ' File wouldn't read - in this case it doesn't
            ' really matter because we're just finding the
            ' directories. However, make sure it doesn't
            ' think it's a directory.
            ItIsDir = 0
            SDebug "Skipping (error): """ & BaseDirectory & "\" & ThisFile & """", 1
            On Error GoTo 0
            Resume Next
SkipFNT:
            On Error GoTo 0
        End If
        ThisFile = Dir
    Wend
    
    ' Go ahead and read all of the filenames matching the
    ' given spec into the array. Similar code to above
    ' but there ain't much we can do.
    FileCount = 0
    ThisFile = Dir(BaseDirectory & "\" & FileName, 32 + 16 + 8 + 4 + 2 + 1)
    While ThisFile <> ""
        ' Check if it's a directory. Need to force the result of
        ' the GetAttr to a boolean because otherwise it isn't and
        ' the "Not" function gets all confused. Don't ask how
        ' *!&"^£%^! long this took me to work out.
        If IncludeDirs Or Not (CBool(GetAttr(BaseDirectory & "\" & ThisFile) And vbDirectory)) Then
            FileCount = FileCount + 1
            ReDim Preserve FilesHere(1 To FileCount)
            FilesHere(FileCount) = ThisFile
        End If
        ThisFile = Dir
    Wend
    
    ' Sort the names into alphabetical order. Using a bubblesort, which
    ' seems to be fast enough at least for the moment.
    If (FileCount > 1) And Sort Then
        Do
            AnyChanges = False
            For BubbleSort = 1 To FileCount - 1
                If FilesHere(BubbleSort) > FilesHere(BubbleSort + 1) Then
                    ' These two need to be swapped
                    SwapFH = FilesHere(BubbleSort)
                    FilesHere(BubbleSort) = FilesHere(BubbleSort + 1)
                    FilesHere(BubbleSort + 1) = SwapFH
                    AnyChanges = True
                End If
            Next BubbleSort
        Loop Until Not AnyChanges
    End If
 
    ' Create any directories necessary. This bit has to go
    ' before the file-handling section because, if directories need to be
    ' created, they need to be created before we start trying to copy files
    ' into them. Note the big lack of error-handling - the usual reason
    ' for directories not being created is because they're already there.
    ' What really matters is the file copies - if they fail, we have to
    ' be careful.
    
    ' If we're copying stuff then make the directory
    If priCopyTo <> "" Then
        SDebug "Creating dir " & priCopyTo & Mid(BaseDirectory, Len(priLookIn) + 1), 2
        On Error Resume Next
        MkDir priCopyTo & Mid(BaseDirectory, Len(priLookIn) + 1)
        On Error GoTo 0
    End If
    
    For AddItem = 1 To FileCount
        ' Presume pleasantly that the copy (if one happens) worked
        CopyFailed = False
        ' If we're copying the files then do that before the delete
        If priCopyTo <> "" Then
            SDebug "Writing file " & priCopyTo & Mid(BaseDirectory & "\" & FilesHere(AddItem), Len(priLookIn) + 1), 2
            On Error GoTo CopyFailedErr
            FileCopy BaseDirectory & "\" & FilesHere(AddItem), priCopyTo & Mid(BaseDirectory & "\" & FilesHere(AddItem), Len(priLookIn) + 1)
            GoTo SkipCopyFailed
CopyFailedErr:
            SDebug "Failed copy to " & priCopyTo & Mid(BaseDirectory & "\" & FilesHere(AddItem), Len(priLookIn) + 1), 1
            CopyFailed = True
            Resume SkipCopyFailed
SkipCopyFailed:
            On Error GoTo 0
        End If
        ' If we're deleting them all then go ahead
        If DeleteFiles And Not CopyFailed Then
            SDebug "Removing file " & BaseDirectory & "\" & FilesHere(AddItem), 2
            SDebug "Clearing attributes", 3
            On Error GoTo FileNotDeleted
            SetAttr BaseDirectory & "\" & FilesHere(AddItem), 0
            SDebug "Deleting", 3
            Kill BaseDirectory & "\" & FilesHere(AddItem)
            GoTo SkipFileNotDeleted
FileNotDeleted:
            SDebug "Failed delete on " & BaseDirectory & "\" & FilesHere(AddItem), 1
            DeletedOkay = False
            Resume SkipFileNotDeleted
SkipFileNotDeleted:
            On Error GoTo 0
        Else
            ' As we're not wiping the whole thing, just
            ' add the files to the list
            FoundFiles.Add BaseDirectory & "\" & FilesHere(AddItem)
        End If
    Next AddItem
    
    ' Okay, here's the recursive bit. We now have an array full
    ' of the directory names from this particular path and we must
    ' cycle through these.
    If SearchSubFolders Then
        For RecurseDirs = 1 To DirCount
            RunDown BaseDirectory & "\" & DirsHere(RecurseDirs)
        Next RecurseDirs
    End If
 
    ' If we're deleting stuff then zap the directory. Remember that
    ' some files in it may have failed copies but that's okay -
    ' if they failed the copy then the file hasn't been deleted
    ' so the rmdir won't work anyway.
    If DeleteFolders Then
        SDebug "Deleting directory " & BaseDirectory, 2
        On Error GoTo DirNotDeleted
        RmDir BaseDirectory
        GoTo SkipDirNotDeleted
DirNotDeleted:
        SDebug "Failed remove on " & BaseDirectory, 1
        DeletedOkay = False
        Resume SkipDirNotDeleted
SkipDirNotDeleted:
        On Error GoTo 0
    End If
 
End Sub

Open in new window

0
 
LVL 21

Expert Comment

by:Alan
ID: 24267320
Hi,

Not sure what you mean?

You said you were wanting to get it in Excel, so the code goes in Excel.

No need to compile it separately - it is VBA not C ;-)

Alan.

0
 

Author Comment

by:tomfolinsbee
ID: 24267441
I am using it in Excel 2007 -- i was refering to where the cursor was when the error message comes up, ie, just after "C:" in the path.  Sorry for the confusion.  Will try the revised version now.
0
 
LVL 21

Expert Comment

by:Alan
ID: 24267457
Yep - Unfortunately they changed the object model in Excel 2007, so try the second one.

When you create the class module, make sure you insert a CLASS module not a standard module.  Sorry if that is obvious - not sure if you are familar with classes.

HTH,

Alan.
0
 

Author Comment

by:tomfolinsbee
ID: 24267460
Same error message :
Compile Error
Expected: list seperator or )
0
 
LVL 21

Expert Comment

by:Alan
ID: 24267463
Hi,

I also noted that you changed the code and hard-wired the folder location.

That is fine, but it needs to be a string:

 .LookIn = "C:\Documents and Settings\user\Favorites\folder name"

HTH,

Alan.
0
 

Author Comment

by:tomfolinsbee
ID: 24267483
Ok, no more compile error thanks.

How do i change the class module name? Don't see any option to rename.
0
 

Author Comment

by:tomfolinsbee
ID: 24267495
renamed it.. thx
0
 

Author Comment

by:tomfolinsbee
ID: 24267499
works fine, thanks for your help.
0
 

Author Closing Comment

by:tomfolinsbee
ID: 31576287
thanks for your help this!
0
 
LVL 21

Expert Comment

by:Alan
ID: 24267514
You're welcome Tom.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction If you're like most people, you have occasionally made a typographical error when you're entering information into an online form.  And to your consternation, the browser remembers the error, and offers to autocomplete your future entr…
If you are a web developer, you would be aware of the <iframe> tag in HTML. The <iframe> stands for inline frame and is used to embed another document within the current HTML document. The embedded document could be even another website.
This Micro Tutorial will demonstrate how to add subdomains to your content reports. This can be very importing in having a site with multiple subdomains.
Shows how to create a shortcut to site-search Experts Exchange using Google in the Chrome browser. This eliminates the need to type out site:experts-exchange.com whenever you want to search the site. Launch the Search Engine Menu: In chrome, via you…

830 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question