├── INSTALL.txt ├── LICENSE.txt ├── NOTES.txt ├── README.md ├── SourceExports └── VBACodeImportExport on 09-08-12 at 16-35-27 │ └── Buttons.bas ├── USAGE.txt ├── VBA Code Import Export.xlam └── VBA Code Import Export.xlsm /INSTALL.txt: -------------------------------------------------------------------------------- 1 | 2 | Install the .xlam file into Excel. 3 | 4 | This can be done one of several ways: 5 | (1) Excel 2010: 6 | run Excel, use File menu, select Options 7 | choose Add-Ins 8 | At "Manage" box, verify Excel Add-Ins is selected in dropdown, 9 | click "Go..." 10 | Click "Browse..." and navigate to the .xlam file. 11 | Click "OK" 12 | Click "OK" 13 | (2) Drag or copy the .xlam file to your Excel Add-Ins folder: 14 | 15 | 16 | You can also open the .xlsm version and use "Save As...", choose the .xlam extension, 17 | and Excel will automatically open the Add-Ins folder. 18 | 19 | 20 | See also: 21 | http://office.microsoft.com/en-us/excel-help/add-or-remove-add-ins-HP010342658.aspx 22 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012 Erik L. Eidt 2 | 3 | Permission is hereby granted, free of charge, to 4 | any person obtaining a copy of this software and 5 | associated documentation files (the "Software"), 6 | to deal in the Software without restriction, 7 | including without limitation to the rights to use, 8 | copy, modify, merge, publish, distribute, 9 | sublicense, and/or sell copies of the Software, 10 | and to permit persons to whom the Software is 11 | furnished to do so, subject to the following 12 | conditions: 13 | 14 | The above copyright notice and this permission 15 | notice shall be included in all copies or 16 | substantial portions of the Software. 17 | 18 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY 19 | OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT 20 | LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 21 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 22 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS 23 | BE LIABLE FOR ANY CLAIM, DAMAGES OR LIABILITY, 24 | WHETHER IN AN ACTION OF CONTRACT, TORT, OR OTHERWISE, 25 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE 26 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 27 | -------------------------------------------------------------------------------- /NOTES.txt: -------------------------------------------------------------------------------- 1 | 2 | NOTES: 3 | VBA Code Import Export.xlsm is there for easier viewing; it is a copy of 4 | VBA Code Import Export.xlam, saved as .xlsm instead of .xlam. 5 | 6 | The SourceExports folder is an example of using the tool on itself, so, 7 | contains a copy of the only VBA source module in the project. 8 | 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | VBA-Src-Extractor 2 | ================= 3 | 4 | This project provides an Excel AddIn that is tool to export/import VBA all the sources to/from a directory in one operation. 5 | 6 | It can be used to backup or archive vba project modules and class files, for example, export files from a .xlsm file to a directory. 7 | 8 | It can also be used to import project modules and class files into .xlsm or an empty .xlsx (which should then be saved as an .xlsm). 9 | 10 | (VBA has the ability to import and export sources; however, it does it one file at a time meaning you have to deal with dialog boxes for each file.) 11 | -------------------------------------------------------------------------------- /SourceExports/VBACodeImportExport on 09-08-12 at 16-35-27/Buttons.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "Buttons" 2 | Option Explicit 3 | 4 | ' 5 | ' Author: Erik L. Eidt 6 | ' Copyright (c) 2012, All rights reserved. 7 | ' Created: 09-08-2012 8 | ' 9 | 10 | Private Const vbext_ct_StdModule = 1 11 | Private Const vbext_ct_ClassModule = 2 12 | Private Const vbext_ct_MSForm = 3 13 | Private Const vbext_ct_Document = 100 14 | 15 | Sub VBACodeImportExport_ExportToFolder() 16 | Dim wkb As Workbook 17 | Set wkb = ActiveWorkbook 18 | 19 | Dim vbp As Variant ' VBIDE.VBProject 20 | Set vbp = wkb.VBProject ' Application.Document.VBProject 21 | 22 | Dim dateTime As String 23 | dateTime = " on " & Format(Now(), "MM-DD-YY at HH-MM-SS") 24 | dateTime = Replace(dateTime, "/", "-") 25 | dateTime = Replace(dateTime, ":", "-") 26 | 27 | Dim exportPath As String 28 | 29 | Dim ans As String 30 | ans = vbNo 31 | If wkb.path <> "" Then 32 | ans = MsgBox("Exporting from vba project: " & vbp.Name & vbCr & "Use project folder for export?" & vbCr & vbCr & "Yes: use project directory" & vbCr & "(" & wkb.path & "\SourceExports\)" & vbCr & vbCr & "No: select another folder...", vbYesNoCancel, "Use project location for export?") 33 | End If 34 | If ans = vbCancel Then 35 | Exit Sub 36 | End If 37 | If ans = vbYes Then 38 | exportPath = CreateDirectory(wkb.path, "SourceExports") 39 | Else 40 | With Application.FileDialog(msoFileDialogFolderPicker) 41 | .Title = "Choose SourceExports Directory (exports will go to timestamped folder name here)" 42 | .ButtonName = "Open" 43 | .Show 44 | exportPath = "" 45 | On Error Resume Next 46 | exportPath = .SelectedItems.Item(1) 47 | If exportPath = "" Then 48 | Exit Sub 49 | End If 50 | End With 51 | End If 52 | 53 | If exportPath = "" Then 54 | ans = MsgBox("Could not create: SourceExports at" & vbCr & ThisWorkbook.path, vbOKOnly, "Export") 55 | Else 56 | exportPath = CreateDirectory(exportPath, vbp.Name & dateTime) 57 | If exportPath = "" Then 58 | ans = MsgBox("Could not create: vbp.Name & dateTime" & vbCr & exportPath, vbOKOnly, "Export") 59 | Else 60 | ans = MsgBox("Exporting" & vbCr & vbCr & "from vba project: " & vbp.Name & vbCr & vbCr & "to folder:" & vbCr & """" & exportPath & """", vbOKCancel, "Export") 61 | 62 | If ans = vbOK Then 63 | Dim cnt As Long 64 | cnt = 0 65 | 66 | Dim vbi As Variant 'VBIDE.VBComponent 67 | For Each vbi In vbp.VBComponents 68 | Dim suffix As String 69 | suffix = "" 70 | Select Case vbi.Type 71 | Case vbext_ct_MSForm 72 | suffix = ".frm" 73 | Case vbext_ct_StdModule 74 | suffix = ".bas" 75 | 'Case vbext_ct_Document 76 | Case vbext_ct_ClassModule 77 | suffix = ".cls" 78 | End Select 79 | If suffix <> "" Then 80 | vbi.Export exportPath & "\" & vbi.Name & suffix 81 | cnt = cnt + 1 82 | End If 83 | Next 84 | MsgBox "Exported " & cnt & " files" & vbCr & vbCr & "to folder:" & vbCr & """" & exportPath & """" & vbCr & vbCr & "from vba project: " & vbp.Name, vbOKOnly, "Success" 85 | End If 86 | End If 87 | End If 88 | End Sub 89 | 90 | Sub VBACodeImportExport_ImportFromFolder() 91 | Dim vbp As Variant 92 | Set vbp = ActiveWorkbook.VBProject ' Application.Document.VBProject 93 | 94 | Dim ans As String 95 | ans = MsgBox("Import folder into vba project: " & vbp.Name & vbCr & "(" & vbp.fileName & ")" & vbCr & vbCr & "Select folder to import using the next dialog box.", vbOKCancel, "Import") 96 | If ans = vbOK Then 97 | Dim path As String 98 | 'path = Application.GetOpenFilename 99 | With Application.FileDialog(msoFileDialogFolderPicker) 100 | .Title = "Choose SourceExports Directory (exports will go to timestamped folder name here)" 101 | .ButtonName = "Open" 102 | .Show 103 | path = "" 104 | On Error Resume Next 105 | path = .SelectedItems.Item(1) 106 | End With 107 | 108 | If path <> "" And path <> "False" Then 109 | Dim vbc As Variant 110 | Set vbc = vbp.VBComponents 111 | 112 | Dim vbi As Variant 113 | Dim fso As Variant 114 | Dim ff As Variant 115 | Dim fl As Variant 116 | Dim fi As Variant 117 | 118 | Dim cnt As Long 119 | cnt = 0 120 | 121 | Set fso = CreateObject("Scripting.FileSystemObject") 122 | 123 | path = TrimToPath(path) 124 | Set ff = fso.GetFolder(path) 125 | Set fl = ff.Files 126 | 127 | For Each fi In fl 128 | Dim modName As String 129 | Dim suffix As String 130 | modName = TrimToSuffix(fi.Name, suffix) 131 | If suffix = ".frm" Or suffix = ".cls" Or suffix = ".bas" Then 132 | Set vbi = Nothing 133 | On Error Resume Next 134 | Set vbi = vbc(modName) 135 | On Error GoTo 0 136 | If vbi Is Nothing Then 137 | Set vbi = vbc.Import(path & "\" & fi.Name) 138 | cnt = cnt + 1 139 | Else 140 | ans = MsgBox(modName & " already exists in VBA Project", vbOKCancel, "Error") 141 | If ans = vbCancel Then 142 | Exit For 143 | End If 144 | End If 145 | End If 146 | Next 147 | MsgBox "Imported " & cnt & " files from:" & vbCr & path & vbCr & "into vba project: " & vbp.Name, vbOKOnly, "Success" 148 | End If 149 | End If 150 | End Sub 151 | 152 | Function CreateDirectory(filePath As String, fileName As String) As String 153 | Dim d As String 154 | d = filePath & "\" & fileName 155 | If Dir(d, vbDirectory) = "" Then 156 | On Error GoTo E1 157 | MkDir d 158 | End If 159 | CreateDirectory = d 160 | Exit Function 161 | E1: CreateDirectory = "" 162 | End Function 163 | 164 | Function TrimToPath(fname As String) As String 165 | Dim p As Long 166 | 167 | p = InStr(1, fname, "\") 168 | If p > 0 Then 169 | Dim q1 As Long 170 | q1 = p 171 | 172 | Dim q2 As Long 173 | Do 174 | q2 = InStr(q1 + 1, fname, "\") 175 | If q2 = 0 Then 176 | Exit Do 177 | End If 178 | q1 = q2 179 | Loop 180 | TrimToPath = Mid(fname, 1, q1 - 1) 181 | Else 182 | TrimToPath = "" 183 | End If 184 | End Function 185 | 186 | Function TrimToSuffix(fname As String, suffixOut As String) As String 187 | Dim p As Long 188 | 189 | p = InStr(1, fname, ".") 190 | If p > 0 Then 191 | Dim q1 As Long 192 | q1 = p 193 | 194 | Dim q2 As Long 195 | Do 196 | q2 = InStr(q1 + 1, fname, ".") 197 | If q2 = 0 Then 198 | Exit Do 199 | End If 200 | q1 = q2 201 | Loop 202 | TrimToSuffix = Mid(fname, 1, q1 - 1) 203 | suffixOut = Mid(fname, q1) 204 | Else 205 | TrimToSuffix = fname 206 | suffixOut = "" 207 | End If 208 | End Function 209 | 210 | 211 | 212 | 213 | 214 | 215 | -------------------------------------------------------------------------------- /USAGE.txt: -------------------------------------------------------------------------------- 1 | Usage: 2 | 3 | From any macro enabled workbook, click one of the two buttons provided by the .xlam: 4 | Export To Folder 5 | Import From Folder 6 | and follow the dialog boxes. 7 | -------------------------------------------------------------------------------- /VBA Code Import Export.xlam: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/erikeidt/VBA-Src-Extractor/7398f536b4dda0bde8510bb4e1f1f620d727d223/VBA Code Import Export.xlam -------------------------------------------------------------------------------- /VBA Code Import Export.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/erikeidt/VBA-Src-Extractor/7398f536b4dda0bde8510bb4e1f1f620d727d223/VBA Code Import Export.xlsm --------------------------------------------------------------------------------