Import a .bas file into a specified workbook.

[Darren Bartrup]

Hi all,

At work I have a folder full of .bas files containing useful UDF's.
At the moment I am the only person in my team that makes use of these files as importing a .bas file is beyond the rest of the team (i.e. then know it contains code so they get scared).

What I'd like to do is create a workbook where they can select one of the files (each file contains a single UDF), maybe see what it does (I put an explanation in the Comments section of the properties for each file) and then have it automatically imported into the workbook of their choice so they can make use of these functions.

Could anyone help with the code needed to import the file and the code to see the comments please?

 

[Haluk]

Hi there;

This is what my alternative is;

First, create a folder named C:\BasFiles

Then, place a bas file (MyMod.bas) in this folder so that the path will be C:\BasFiles\MyMod.bas

By right clicking on this file, insert your comment text for this file named, MyMod.bas

Now, copy and paste the following code into a module in a workbook and run the procedure named Test.

When you run the procedure, the comment you entered to the MyMod.bas file will be shown via a MsgBox and you will be prompted whether to import the file named MyMod.bas.

The related code is;

Sub Test()
    Dim BasFolder As String
    Dim BasFile As String
    Dim WshShell As Object
    Dim objShell As Object
    Dim objFolder As Object
    Dim MyFile As Object
    
    BasFolder = "C:\BasFiles"
    BasFile = "MyMod.bas"
    
    Set WshShell = CreateObject("WScript.Shell")
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace("" & BasFolder & "")
    
    For Each MyFile In objFolder.items
        If MyFile = BasFile Then
            MyQ = MsgBox("Comment : " & objFolder.GetDetailsOf(MyFile, 5) _
                   & vbCrLf & "Do you want to import this module to your project ?", vbYesNo)
            If MyQ = vbYes Then
                ActiveWorkbook.VBProject.VBComponents.Import _
                   BasFolder & Application.PathSeparator & BasFile
            End If
        End If
    Next
    
    Set objFolder = Nothing
    Set objShell = Nothing
    Set WshShell = Nothing
End Sub

The above code is prepared under Win2000 + Office2000

I've not tried the code under different versions of OS or Excel.

You can ammend the code to suit your needs.

 

[Darren Bartrup]

That looks great. Thanks Haluk, I'll let you know how I get on.

 

[Darren Bartrup]

Worked great Haluk.

Here's my final solution:
All the .bas files in the folder are displayed in column A, and the contents of the Comments property of the file are displayed in column B. This is refreshed everytime you open the file.
When you double-click a file name you are asked to select the open workbook to import the file to.
The destination file is checked for the existence of any VBComponents with the same name and you are given the choice to import anyway.
The UDF is then available to be used in the workbook

Create a new workbook with a single sheet, set the (Name) property to 'shtBasListing'.
Enter this code into the Worksheet object:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lLastRow As Long
'//Return last cell containing data in column 1.
lLastRow = Me.Cells(65536, 1).End(xlUp).Row
'//If Target is one of the .bas file names.
If Target.Column = 1 And _
    Target.Row > 2 And _
    Target.Row <= lLastRow Then
    If MsgBox("Import " & Target.Value & "?", _
        vbQuestion + vbYesNo + vbDefaultButton2, "Import .bas file.") = vbYes Then
        Load frmWrkBkList
        frmWrkBkList.Show
    End If
End If
End Sub

Enter this code into the ThisWorkbook object:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Me.Saved = True
End Sub

Private Sub Workbook_Open()
    PopulateWorkSheet
End Sub

Insert a UserForm into the project, set the (Name) property to 'frmWrkBkList'.
Add a ListBox named 'lstImportList' and a CommandButton named 'cmdOK'
Add this code to the form:

Option Explicit

Private Sub cmdOK_Click()
Dim vbComp      As Variant
Dim lResponse   As Long
For Each vbComp In Workbooks(Me.lstImportList.Value).VBProject.VBComponents
    If Left(ActiveCell.Value, Len(ActiveCell.Value) - 4) = vbComp.Name Then
        lResponse = MsgBox("'" & vbComp.Name & "' already exists in the destination workbook." & _
            vbCr & vbCr & "Do you wish to import the file anyway (this will not overwrite " & _
            "the existing module)?", vbQuestion + vbYesNo + vbDefaultButton2)
        Exit For
    End If
Next vbComp
If lResponse = 6 Or lResponse = 0 Then
    Workbooks(Me.lstImportList.Value).VBProject.VBComponents.Import _
        shtBasListing.Cells(1, 2) & Application.PathSeparator & ActiveCell.Value
    MsgBox "'" & ActiveCell.Value & "'" & vbCr & "has been imported to" & _
        vbCr & "'" & Me.lstImportList.Value & "'", vbInformation + vbOKOnly
End If
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim wrkBk   As Workbook
For Each wrkBk In Application.Workbooks
    If wrkBk.Name <> ThisWorkbook.Name Then
        Me.lstImportList.AddItem (wrkBk.Name)
    End If
Next wrkBk
End Sub

Finally, insert Module and enter this code:
NB: Change value of basFolder to point to your directory.

Option Explicit
Option Base 1

'//Define folder path.
Private Const basFolder As String = "<ENTER PATH TO FOLDER HERE>"

'Purpose:       Imports the .bas file names into the shtBasListing worksheet.
Sub PopulateWorkSheet()
Dim basNames    As Variant
Dim lCntr1      As Long
'//Get all bas file names from specified path.
basNames = udfGetFileNames
shtBasListing.Cells.Clear
'//If there aren't any bas files display a message and end.
If basNames(LBound(basNames), 1) = "" Then
    MsgBox "No bas files found in:" & vbCr & basFolder, vbCritical + vbOKOnly
Else
    Application.ScreenUpdating = False
    With shtBasListing
        .Cells(1, 1) = "Path:"
        .Cells(1, 2) = basFolder
        '//Add headings.
        With .Range("A2:B2")
            .Value = Array("Function", "Description")
            .Interior.ColorIndex = 35
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
        End With
        '//Add values from array.
        For lCntr1 = LBound(basNames, 2) To UBound(basNames, 2)
            .Cells(lCntr1 + 2, 1) = basNames(1, lCntr1)
            .Cells(lCntr1 + 2, 2) = basNames(2, lCntr1)
        Next lCntr1
        '//Format the worksheet.
        With .Range("A3:A" & lCntr1 + 1)
            .VerticalAlignment = xlCenter
            .Font.Underline = xlUnderlineStyleSingle
            .Font.ColorIndex = 5
        End With
        .Range("B3:B" & lCntr1 + 1).WrapText = True
        With .Range("A2:B" & lCntr1 + 1)
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            '//An error will occur if there is only 1 row.
            On Error Resume Next
            .Borders(xlInsideHorizontal).Weight = xlHairline
            On Error GoTo 0
        End With
        .Columns("A:A").AutoFit
        .Columns("B:B").ColumnWidth = 75.29
        .Rows("3:" & lCntr1 + 2).AutoFit
    End With
    Application.ScreenUpdating = True
End If
End Sub

'Purpose:       Returns all .bas files within the specified path.
Function udfGetFileNames() As Variant
Dim fleName         As String
Dim basIndex()      As String
Dim WshShell        As Object
Dim objShell        As Object
Dim objFolder       As Object
Dim basFile         As Object
Set WshShell = CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.namespace("" & basFolder & "")

'//Get first file name.
fleName = Dir(basFolder & Application.PathSeparator & "*.bas", vbNormal)
ReDim basIndex(1 To 2, 1 To 1)
Set basFile = objFolder.parsename(fleName)
'//Put file name and comments into array.
basIndex(1, UBound(basIndex, 2)) = fleName
basIndex(2, UBound(basIndex, 2)) = objFolder.GetDetailsOf(basFile, 14)
'//Search for further files, increasing the size of the array at each pass.
Do While fleName <> ""
    fleName = Dir()
    If fleName <> "" Then
        Set basFile = objFolder.parsename(fleName)
        ReDim Preserve basIndex(1 To 2, 1 To UBound(basIndex, 2) + 1)
        basIndex(1, UBound(basIndex, 2)) = fleName
        basIndex(2, UBound(basIndex, 2)) = objFolder.GetDetailsOf(basFile, 14)
    End If
Loop
udfGetFileNames = basIndex
End Function

 

[Haluk]

Hi Delmar;

This is a nice work...

Seems like you are using WinXP. May be you can add few more lines to consider different types of OS. (For finding the "Comments" property)

Such as;

Sub Test2()
    Dim BasFolder As String
    Dim BasFile As String
    Dim WshShell As Object
    Dim objShell As Object
    Dim objFolder As Object
    Dim MyFile As Object
    Dim i As Byte
    
    BasFolder = "C:\BasFiles"
    BasFile = "MyMod.bas"
    
    Set WshShell = CreateObject("WScript.Shell")
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace("" & BasFolder & "")
    
    For Each MyFile In objFolder.Items
        If MyFile = BasFile Then
            For i = 0 To 25
                If Left(objFolder.GetDetailsOf(objFolder.Items, i), 7) = "Comment" Then Exit For
            Next
            MyQ = MsgBox("Comment : " & objFolder.GetDetailsOf(MyFile, i) _
                   & vbCrLf & "Do you want to import this module to your project ?", vbYesNo)
            If MyQ = vbYes Then
                ActiveWorkbook.VBProject.VBComponents.Import _
                   BasFolder & Application.PathSeparator & BasFile
            End If
        End If
    Next
    
    Set objFolder = Nothing
    Set objShell = Nothing
    Set WshShell = Nothing
End Sub

 

[Darren Bartrup]

I'll try that, thanks (yes, using WinXP & Excel 2002).

Just noticed that I didn't tidy up at the end of the procedure either.
I should really put in something that checks the Excel version, just to make sure the imported procedures will run properly. I could store the minimum requirements in the Category property.

The only problem I've come across is that the Comments will only display 255 characters (though it lets me type in more than that). I was hoping to use it to display a complete help file for the use of each function - maybe abit ambitious.

 

[Phantomchaser]

The code

Tried your code, everything is in place, but when clicking cmdOK I get type mismatch Runtime 13, any idea? I´m not a guru so I hope you guys can help me.

It stops and this line..
For Each vbComp In Workbooks
(Me.lstImportList.Value).VBProject.VBComponents

Thanks
/Magnus

 

[Darren Bartrup]

Hi PhantomChaser,
Sorry took so long to reply.

Do you have the workbook open that you are trying to import the file to, and have you selected it from the listbox?

If Me.lstImportList.Value = Null then nothing's been selected in the listbox (again, sorry - should've put in some code to cover that).

 

[Phantomchaser]

......

Ok, now I understand it..

I couldn´t figure that out ( tried to understand the code ) but know i´ve solved it as you told me.

Your work with the code is great. 1 question pops up though.
Suppose you want to add all of the vba modules you have in the folder at the same time.. any solution for that?

 

[Darren Bartrup]

Sorry taking so long again - been on a course for the last couple of days.

I haven't got a copy of Excel on this computer, but looking at the code you could change the properties on the listbox to multiple selection and add a loop to the cmdOK_Click() procedure to cycle through each selection.

I'm going to have to add more code to this. Lots of improvements that can be made.