MrBlackd
04-06-2014, 02:25 AM
I do not know if this is already shared but since I have found a part of it online and made some additions from older downloaded code I thought to share it.
This will save all modules, class modules and forms to a selected folder.
To the mods: I suspect that this might not be the proper subforum to share the code and I apologize but I didn't know where exactly to share.
Please by all means transfer it to the proper location if needed. :)
Option Explicit
' ---------------------- Directory Choosing Helper Functions -----------------------
' Excel and VBA do not provide any convenient directory chooser or file chooser
' dialogs, but these functions will provide a reference to a system DLL
' with the necessary capabilities
Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, Path As String, R As Long
Dim x As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
x = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
Path = Space$(512)
R = SHGetPathFromIDList(ByVal x, ByVal Path)
If R Then
pos = InStr(Path, Chr$(0))
GetFolderName = Left(Path, pos - 1)
Else
GetFolderName = ""
End If
End Function
'---------------------- END Directory Chooser Helper Functions ----------------------
Sub ExportMods()
' reference to extensibility library
'Tip : you need to set the VBA Extension reference. In your workbook go into the VBA screen and Select the Tools Menu and References
'then search for Micrsoft Visual Basic For Applications Extensibility 5 and tick the box then you can run the code
Dim Path As String
Dim objMyProj As VBProject
Dim objVBComp As VBComponent
Set objMyProj = Application.VBE.ActiveVBProject
Path = GetFolderName("Choose the folder to export BAS files to:")
If Path = "" Then
MsgBox ("You didn't choose an export directory. Nothing will be exported.")
Exit Sub
End If
For Each objVBComp In objMyProj.VBComponents
If objVBComp.Type = vbext_ct_ClassModule Or vbext_ct_MSForm Or vbext_ct_StdModule Then
objVBComp.Export Path & "\" & objVBComp.Name & ".bas"
End If
Next
End Sub
This will save all modules, class modules and forms to a selected folder.
To the mods: I suspect that this might not be the proper subforum to share the code and I apologize but I didn't know where exactly to share.
Please by all means transfer it to the proper location if needed. :)
Option Explicit
' ---------------------- Directory Choosing Helper Functions -----------------------
' Excel and VBA do not provide any convenient directory chooser or file chooser
' dialogs, but these functions will provide a reference to a system DLL
' with the necessary capabilities
Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, Path As String, R As Long
Dim x As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
x = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
Path = Space$(512)
R = SHGetPathFromIDList(ByVal x, ByVal Path)
If R Then
pos = InStr(Path, Chr$(0))
GetFolderName = Left(Path, pos - 1)
Else
GetFolderName = ""
End If
End Function
'---------------------- END Directory Chooser Helper Functions ----------------------
Sub ExportMods()
' reference to extensibility library
'Tip : you need to set the VBA Extension reference. In your workbook go into the VBA screen and Select the Tools Menu and References
'then search for Micrsoft Visual Basic For Applications Extensibility 5 and tick the box then you can run the code
Dim Path As String
Dim objMyProj As VBProject
Dim objVBComp As VBComponent
Set objMyProj = Application.VBE.ActiveVBProject
Path = GetFolderName("Choose the folder to export BAS files to:")
If Path = "" Then
MsgBox ("You didn't choose an export directory. Nothing will be exported.")
Exit Sub
End If
For Each objVBComp In objMyProj.VBComponents
If objVBComp.Type = vbext_ct_ClassModule Or vbext_ct_MSForm Or vbext_ct_StdModule Then
objVBComp.Export Path & "\" & objVBComp.Name & ".bas"
End If
Next
End Sub