Excel

Create the Personal.xls workbook and import files

Ease of Use

Intermediate

Version tested with

2000, 2003 

Submitted by:

malik641

Description:

Creates the Personal.xls workbook to store your vba procedures and userforms or adds code files to your existing one. 

Discussion:

Normally people create the Personal.xls workbook by recording a macro to it. I don't like this method because once created you usually delete the recorded code (because you would most likely use it to just create the Personal.xls) and then import all of your modules, class modules, and userforms. This procedure automates this for you plus lets you import multiple selections (rather than one-at-a-time when you normally import files to the VBE). If your file already exists, then this code will import .bas files etc. into your Personal.xls Worbook 

Code:

instructions for use

			

Option Explicit Option Compare Text Sub AddPersonal() Application.ScreenUpdating = False Dim Filt As String, Title As String, FilterIndex As Integer, i As Integer, FileName Dim blnPersonal As Boolean Dim FSO As Object, Folder As Object, File As Object Dim PersonalXLS As Workbook 'Create an instance of the FileSystemObject and obtain the 'excel startup folder Set FSO = CreateObject("Scripting.FileSystemObject") Set Folder = FSO.GetFolder(Application.StartupPath) 'See if Personal.xls already exists For Each File In Folder.Files If UCase(File.Name) = "PERSONAL.XLS" Then If WorkbookIsOpen(File.Name) Then Set PersonalXLS = Application.Workbooks(File.Name) Else Set PersonalXLS = Application.Workbooks.Open(File.Path) End If blnPersonal = True Exit For End If Next 'Prompt user to continue if Personal.xls was found If blnPersonal = True Then If MsgBox("Personal.xls already exists." & vbCrLf & vbCrLf & _ "Would you like to add modules to it?", vbYesNo, _ "Personal.xls Exists") = vbNo Then GoTo ExitHere End If 'If Personal.xls was not found, create Personal.xls workbook and hide it If blnPersonal = False Then Set PersonalXLS = Application.Workbooks.Add PersonalXLS.SaveAs (Application.StartupPath & "\PERSONAL.xls") Windows("PERSONAL.xls").Visible = False 'After Personal.xls is created, ask to import modules to it If MsgBox("Personal.xls created." & vbCrLf & vbCrLf & "Would you like to import modules?", _ vbYesNo, "Personal.xls Created") = vbNo Then GoTo ExitHere End If 'Set up list of file filters Filt = "All Files (*.*),*.*," & _ "Basic Files (*.bas),*.bas," & _ "Class Files (*.cls),*.cls," & _ "Form Files (*.frm),*.frm," 'Display *.* by default FilterIndex = 5 'Set the Dialog Caption Title = "Select a File to Import" 'Get The File Name(s) FileName = Application.GetOpenFilename _ (FileFilter:=Filt, _ FilterIndex:=FilterIndex, _ Title:=Title, _ MultiSelect:=True) 'If no files are selected then exit the procedure If TypeName(FileName) = "Boolean" Then GoTo ExitHere 'Import the Files to the Personal.xls workbook For i = LBound(FileName) To UBound(FileName) PersonalXLS.VBProject.VBComponents.Import (FileName(i)) Next ExitHere: 'Clean up PersonalXLS.Save Set PersonalXLS = Nothing Set FSO = Nothing Set Folder = Nothing Set File = Nothing Application.ScreenUpdating = True End Sub 'Function thanks to John Walkenbach Private Function WorkbookIsOpen(wbName) As Boolean 'Returns TRUE if the workbook is open Dim wb As Workbook On Error Resume Next Set wb = Application.Workbooks(wbName) If Err = 0 Then WorkbookIsOpen = True Else WorkbookIsOpen = False End Function

How to use:

  1. Download the attachment
  2. Extract the workbook
  3. Open workbook
  4. Enable Macros
 

Test the code:

  1. Press Alt+F8
  2. Run AddPersonal
  3. Choose files to import to the Personal.xls
 

Sample File:

Create Personal.zip 14.54KB 

Approved by mdmackillop


This entry has been viewed 499 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express