Prev: To get the same header,footer and sheet titles across multiple sheets of a workbook.
Next: To get the same header,footer and sheet titles across multiple she
From: Ian on 24 Feb 2010 00:48
I know this post is really old and I doubt I will get a reply.. Can you post your working script for excel spreadsheets? This is exactly what I have been looking for. Good work!



Phil Hibbs wrote:

Fixed it - I cannot use the module name as a collection index, I needto loop
07-Jan-10

Fixed it - I cannot use the module name as a collection index, I need
to loop through them checking the Name property of the VBComponent.

Phil Hibbs.

Previous Posts In This Thread:

On Thursday, January 07, 2010 8:32 AM
Phil Hibbs wrote:

Updating the VBA code in multiple spreadsheets
I asked about this a while ago, now I have a solution. I have used
AutoIt (http://www.autoitscript.com/) , but I think this could also be
done in VB.

It can work in one of two ways:

1. Run it, select the file that contains the new VBA code, then select
the Excel spreadsheet to update
2. Drag and drop a set of files onto a compiled version, and you will
only be prompted for the VBA code

The reason I did the latter rather than just multi-selecting in the
File Open Dialog is that I want to be able to process multiple files
across multiple directories, so I search in Explorer and then drag a
set of search results onto the executable.

The first line of the VBA code file must be in this format:
`Name=MyModule

This specifies the module that will be removed, and the newly imported
module will be given this name.

This is the code of the AutoIt script:

$oExcel = ObjCreate("Excel.Application")
$oExcel.Visible = 0
$ModuleCode = FileOpenDialog("Select Excel File", "C:\", "VBA Module
Code (*.txt;*.bas)", 1 )
If @error Then Exit
$CodeFile = FileOpen( $ModuleCode, 0 )
$ModuleName = FileReadLine( $CodeFile )
FileClose( $CodeFile )
If StringLeft( $ModuleName, 6 ) = "'Name=" Then
$ModuleName = StringMid( $ModuleName, 7 )
If $CmdLine[0] > 0 Then
$FileName = ""
For $i = 1 To $CmdLine[0]
$FileName &= "|" & $CmdLine[$i]
Next
$FileName = StringMid( $FileName, 2 ) ; remove the first |
character
Else
$FileName = FileOpenDialog("Select Excel File", "C:\", "Excel
Workbooks (*.xls)", 1 )
If @error Then Exit
EndIf
$xlscount = 0
For $xls In StringSplit( $FileName, "|", 2 )
ReplaceMacro( $xls, $ModuleName, $ModuleCode )
$xlscount += 1
Next
MsgBox( 1, "Finished", $xlscount & " files updated" )
Else
MsgBox( 1, "Error", "First line must begin with 'Name="
EndIf

Func ReplaceMacro( $FileName, $ModuleName, $ModuleCode )
$oExcel.WorkBooks.Open($FileName)
$oModules = $oExcel.ActiveWorkbook.VBProject.VBComponents
For $oModule in $oModules
If $oModule.Type = 1 And $oModule.Name = $ModuleName Then
$oModules.Remove( $oModule )
EndIf
Next
$oModules.Import( $ModuleCode )
$oModules = $oExcel.ActiveWorkbook.VBProject.VBComponents
$ModuleCount = 0
For $oModule in $oModules
$ModuleCount += 1
If $ModuleCount = $oModules.Count Then
$oModule.Name = $ModuleName
EndIf
Next
$oExcel.ActiveWorkbook.Save
$oExcel.ActiveWorkbook.Close
$oExcel.Quit
EndFunc

--
Phil Hibbs.

On Thursday, January 07, 2010 12:24 PM
Phil Hibbs wrote:

I am now trying to port this to Excel, and I am hitting a problem wherethe
I am now trying to port this to Excel, and I am hitting a problem where
the Remove method fails with "Object does not support this method or
property":

Sub UpdateVBA()
Dim oExcel As Application
Dim oComponent As Object

Set oExcel = New Excel.Application
Set oBook = oExcel.Workbooks.Open("C:\Test.xls", 0, False, , , ,
True)
Set oComponent = oBook.VBProject.VBComponents("TestModule")
oBook.VBProject.VBComponents.Remove (oComponent) ' <== FAIL
oBook.VBProject.VBComponents.Import ("C:\TestModule.txt")
oBook.VBProject.VBComponents
(oBook.VBProject.VBComponents.Count).Name = "TestModule"
oBook.Close
oExcel.Quit

End Sub

Any ideas?

Phil Hibbs.

On Thursday, January 07, 2010 12:24 PM
Phil Hibbs wrote:

Fixed it - I cannot use the module name as a collection index, I needto loop
Fixed it - I cannot use the module name as a collection index, I need
to loop through them checking the Name property of the VBComponent.

Phil Hibbs.


Submitted via EggHeadCafe - Software Developer Portal of Choice
Generic Feed Parsers Redux
http://www.eggheadcafe.com/tutorials/aspnet/42a9b6e2-809e-4ca7-b3f6-acd41f462063/generic-feed-parsers-redu.aspx
From: Phil Hibbs on 24 Feb 2010 05:12
On Feb 24, 5:48 am, Ian G wrote:
> I know this post is really old and I doubt I will get a reply..
> Can you post your working script for excel spreadsheets?
> This is exactly what I have been looking for. Good work!

Here's the module. The layout of the sheet that stores the names of
the spreadsheets and modules to update should be clear from the
constants. You might also need to enable Microsoft Scripting Runtime,
in the Tools->References menu in the VBA code editor window.

'Name=UpdateVBA
'Ver=1.0
'Author=Phil Hibbs
'Copyright=Capgemini 2009-2010
'
' Updates the VBA code in multiple spreadsheets from text files
'
' Buttons generated by http://www.grsites.com/generate/resultbyid/6275218/

Const SelectCol = 1
Const PathCol = 2
Const FileCol = 3
Const ModuleCol = 4
Const CodeCol = 5
Const DoneCol = 6

Const HeaderRow = 1

Sub UpdateVBA()
Dim oExcel As Application
Dim oBook As Workbook
Dim i As Integer
Dim j As Integer
Dim FileName As String
Dim PrevName As String
Dim oComponents As Object
Dim ErrNum As Long

On Error GoTo ErrorHandler

Set oExcel = New Excel.Application
oExcel.DisplayAlerts = False

i = HeaderRow + 1
While Cells(i, FileCol) <> ""
Cells(i, DoneCol) = ""
i = i + 1
Wend

i = HeaderRow + 1
While Cells(i, FileCol) <> ""
If Cells(i, SelectCol) <> "" Then
Cells(i, DoneCol).Activate
PrevName = FileName
FileName = Cells(i, FileCol)
If Cells(i, PathCol) <> "" Then FileName = Cells(i,
PathCol) & "\" & FileName
If PrevName <> FileName Then
If Not oBook Is Nothing Then
oBook.Close SaveChanges:=True
End If
Set oBook = oExcel.Workbooks.Open(FileName, 0,
False, , , , True)
End If
Set oComponents = oBook.VBProject.VBComponents
For j = oComponents.Count To 1 Step -1
If oComponents(j).Name = Cells(i, ModuleCol).Text Then
oComponents.Remove oComponents(j)
Exit For
End If
Next j
oComponents.Import (Cells(i, CodeCol))
oComponents(oComponents.Count).Name = Cells(i, ModuleCol)
oExcel.Run ("UpdateMacro")
Cells(i, DoneCol) = "ü"
End If
i = i + 1
Wend
If Not oBook Is Nothing Then
oBook.Close SaveChanges:=True
End If

Exit Sub

ErrorHandler:
'Store the error
ErrNum = Err.Number
If Err.Description = "The macro 'UpdateMacro' cannot be found."
Then Resume Next

oExcel.Quit

Err.Raise ErrNum

End Sub

Sub FillFiles()

Dim oFSO As FileSystemObject 'The File System Object used for
all File IO
Dim i As Integer
Dim StartPath As String
Dim Path As String

i = Selection.Row
Path = Cells(i, PathCol)
If Path = "" Then
If InStr(Cells(i - 1, PathCol), ":") > 0 Then
StartPath = Cells(i - 1, PathCol)
End If
Path = GetSelectedFolder(StartPath)
If Path = "" Then
Exit Sub
End If
End If

Cells(i, PathCol) = Path
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Folder = oFSO.GetFolder(Path)

For Each file In Folder.Files
If file.Type Like "*Microsoft Excel*" Then
If Cells(i, PathCol) = "" Then
Cells(i, PathCol).Formula = "=" & Num2Col(PathCol) &
Trim(i - 1)
End If
Cells(i, FileCol) = file.Name
i = i + 1
End If
Next file
Set oFSO = Nothing


End Sub

Function GetSelectedFolder(Optional strPath As String) As String
Dim objFldr As FileDialog
Set objFldr = Application.FileDialog(msoFileDialogFolderPicker)
With objFldr
.Title = "Select a folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GetSelectedFolder = "": Exit Function
GetSelectedFolder = .SelectedItems(1)
End With
Set objFldr = Nothing
End Function

Function Num2Col(ColNum As Integer) As String

Dim Col As Integer
Dim Letter As Integer

Letter = 0
Num2Col = ""

If ColNum > 26 Then
Letter = ColNum / 26
Num2Col = Chr(Letter + 64)
End If
Letter = ColNum Mod 26
Num2Col = Num2Col & Chr(Letter + 64)

End Function

 | 
Pages: 1
Prev: To get the same header,footer and sheet titles across multiple sheets of a workbook.
Next: To get the same header,footer and sheet titles across multiple she