Hi All
I am trying to auto replace a module in a series of workbooks.
The following is some borrowed code (from internet searches) and some of my own.
The problem is the loop through the directory does not work.
I have tracked the cause to the
Although this is correct it causes the loop command to exit the routine I.E. Although there are twelve workbooks in the directory, after the first workbook is saved and closed the
command sets F=""
Can anyone help me get round this?
Duncan
I am trying to auto replace a module in a series of workbooks.
The following is some borrowed code (from internet searches) and some of my own.
The problem is the loop through the directory does not work.
I have tracked the cause to the
function call.
Although this is correct it causes the loop command to exit the routine I.E. Although there are twelve workbooks in the directory, after the first workbook is saved and closed the
Code:
F=Dir()Can anyone help me get round this?
Duncan
Code:
Sub FileInfo()
Dim wb As Excel.Workbook
Set wb = ThisWorkbook
Dim wbFrom As Workbook
Dim wsF As Excel.Worksheet
Dim wsT As Excel.Worksheet
Dim r As Integer
Dim F As String, Directory As String, ToBook As String, runHere As Workbook
Dim FromBook As String, FromSheet As String, jumpsCount As Long, flatCount As Long, tom As String
Set wsT = wb.Sheets("Records_")
tom = Format(Now + 1, "dd/mm/yy")
tom = Replace(tom, "/", "")
Directory = "D:\Data0209 Onwards - Copy" 'wb.Path
ToBook = wb.Name
r = 2
'Get Directory
F = Dir(Directory & "\")
Do While F <> ""
If Not F = "dataGrab_" & tom & ".xlsm" Then
Application.ShowWindowsInTaskbar = False
Application.ScreenUpdating = False
' Get Results Here
r = r + 1
FromBook = (Directory & "\" & F)
Workbooks.Open Filename:=FromBook, ReadOnly:=False
Set wbFrom = Workbooks(F)
DeleteVBComponent wbFrom, "Module4"
InsertVBComponent wbFrom, "D:\Automated Betting\XL Macros\260209Module4.bas"
Application.Run F & "!colorCells"
For Each wsF In wbFrom.Worksheets
FromSheet = wsF.Name
If Not InStr(1, FromSheet, "_") <> 0 Then
Call typeTest(wsF.Range("A1"))
Select Case raceType
Case Is = "jumps"
jumpsCount = jumpsCount + 1
Case Is = "flat"
flatCount = flatCount + 1
End Select
End If
Next
' loop through all results Books
wbFrom.Save
wbFrom.Close Savechanges:=True
End If
F = Dir()
Loop
Application.ShowWindowsInTaskbar = True
Application.ScreenUpdating = True
Debug.Print jumpsCount
Debug.Print flatCount
End Sub
Function InsertVBComponent(ByVal wkb As Workbook, ByVal CompFileName As String)
' inserts the contents of CompFileName as a new component in wb
' CompFileName must be a valid VBA component suited for
' import (an exported VBA component)
If Dir(CompFileName) <> "" Then
' source file exist
On Error Resume Next ' ignores any errors if the project is protected
' wb.VBProject.VBComponents("Module4").Replace
wkb.VBProject.VBComponents.Import CompFileName
' inserts component from file
On Error GoTo 0
End If
Set wkb = Nothing
End Function
Function DeleteVBComponent(ByVal wb As Workbook, ByVal CompName As String)
' deletes the vbcomponent named CompName from wb
Application.DisplayAlerts = False
On Error Resume Next ' ignores any errors
wb.VBProject.VBComponents.Remove wb.VBProject.VBComponents(CompName)
' delete the component
On Error GoTo 0
Application.DisplayAlerts = True
End Function
