Full Script for Excel Spreadsheet Import Automation

[Ian G]

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 nee
to loop through them checking the Name property of the VBComponent

Phil Hibbs.

Previous Posts In This Thread:

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

It can work in one of two ways

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

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

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

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

This is the code of the AutoIt script

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

Func ReplaceMacro( $FileName, $ModuleName, $ModuleCode
$oExcel.WorkBooks.Open($FileName
$oModules = $oExcel.ActiveWorkbook.VBProject.VBComponent
For $oModule in $oModule
If $oModule.Type = 1 And $oModule.Name = $ModuleName The
$oModules.Remove( $oModule
EndI
Nex
$oModules.Import( $ModuleCode
$oModules = $oExcel.ActiveWorkbook.VBProject.VBComponent
$ModuleCount =
For $oModule in $oModule
$ModuleCount +=
If $ModuleCount = $oModules.Count The
$oModule.Name = $ModuleNam
EndI
Nex
$oExcel.ActiveWorkbook.Sav
$oExcel.ActiveWorkbook.Clos
$oExcel.Qui
EndFun

-
Phil Hibbs.

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 wher
the Remove method fails with "Object does not support this method o
property"

Sub UpdateVBA(
Dim oExcel As Applicatio
Dim oComponent As Objec

Set oExcel = New Excel.Applicatio
Set oBook = oExcel.Workbooks.Open("C:\Test.xls", 0, False, , ,
True
Set oComponent = oBook.VBProject.VBComponents("TestModule"
oBook.VBProject.VBComponents.Remove (oComponent) ' <== FAI
oBook.VBProject.VBComponents.Import ("C:\TestModule.txt"
oBook.VBProject.VBComponent
(oBook.VBProject.VBComponents.Count).Name = "TestModule
oBook.Clos
oExcel.Qui

End Su

Any ideas

Phil Hibbs.

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 nee
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/tutorial...6-acd41f462063/generic-feed-parsers-redu.aspx

 

[Phil Hibbs]

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