How to attack the problem with activeX configuration, when vba programming in Office and Automate so

[Peter Wang]

Dear all,

Firstly put some words on Automate. It's a great automation platform, which
supports vba coding. You can refer the web site
http://www.networkautomation.com/automate/automate6/ for more informations.

I recently wrote vba code for the automate task, that takes some operations
on xls files.

When I run the code on my laptop with automate, it always aborts at line 92
¡°xlApp.Workbooks.Open (filePath & "ThisWeek.xls")¡±, with the error
msg:Script error: "(10090) ActiveX Automation error."

Still in my laptop, if I copy the code into MS Office macro(no matter in
excel\word\outlook etc), it runs pretty well.

So I choose another computer, with the same Windows XP,Office 2003 and
Automate. It runs well too!

There are must be something wrong with the activeX configuration of my
laptop. Could you give me instructions on how to dump and compare the
activeX configuration of those two computers, so that I would find the root
cause and correct it.

Thanks for your time.
Peter Wang
¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª¡ª
Attached with my vba code.

Public
curWeekDayStr As String
Public filePath As String, curHour As Integer, curMin As Integer,
curWeekDayNum As Integer


Sub Main()

filePath="G:\My AutoMate Tasks\"
curHour = Hour(Time)
curMin = Minute(Time)
curWeekDayStr = Format(Date, "ddd")
curWeekDayNum =(Weekday(Date) +6 ) Mod 7
If curWeekDayNum = 0 Then curWeekDayNum = 7


If curWeekDayStr = "Mon" And curHour = 0 And curMin = 10 Then
Call ActionofMonday0010
Else
Call ActionofNormalTime
End If


End Sub


Private Sub ActionofMonday0010()

Dim basicFileName As String, needFileName As String, foundFileName As
String, newestFileName As String, current As String
Dim foundCreated As Variant, newestCreated As Variant

Set fs = CreateObject("Scripting.FileSystemObject")

basicFileName = Format(Date, "yyyy") & "w??md" & Format(Date, "mmdd") &
".xls"
needFileName = filePath & "*" & basicFileName
foundFileName = Dir$(needFileName)

newestCreated = 0
Do While foundFileName > ""
foundCreated = fs.GetFile(filePath & foundFileName).DateCreated
If foundCreated > newestCreated Then
newestCreated = foundCreated
newestFileName = foundFileName
End If
foundFileName = Dir$
Loop

If newestFileName = "" Then Exit Sub

current = filePath & "ThisWeek.xls"
If fs.FileExists(current) Then
On Error Resume Next
Dim xlApp As Object, xlsFile As Object
Set xlApp = GetObject(, "Excel.Application")

If Err.Number = 0 Then
On Error GoTo 0
For Each xlsFile In xlApp.Workbooks
If xlsFile.Name = "ThisWeek.xls" Then
xlApp.Workbooks("ThisWeek.xls").Close
Next
Else
Err.Clear
On Error GoTo 0
End If
fs.DeleteFile current, True
End If
fs.CopyFile filePath & newestFileName, current

End Sub

Private Sub ActionofNormalTime()

Dim foundFileName As String
foundFileName = Dir$(filePath & "ThisWeek.xls")
If foundFileName = "" Then Exit Sub

If curHour <= 7 Or curHour = 23 Then Exit Sub

On Error Resume Next
Dim xlApp As Object, xlsFile As Object, isOpen As Boolean
isOpen = False
Set xlApp = GetObject(, "Excel.Application")
If Err.Number = 0 Then
On Error GoTo 0
For Each xlsFile In xlApp.Workbooks
If xlsFile.Name = "ThisWeek.xls" Then isOpen = True
Next
Else
Err.Clear
On Error GoTo 0
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
End If
If isOpen = False Then
xlApp.Workbooks.Open (filePath & "ThisWeek.xls")
end if

Dim xlSht As Object
Set xlsFile = xlApp.Workbooks("ThisWeek.xls")
Set xlSht = xlsFile.Worksheets(curWeekDayStr)

Dim xlCell As Object
Set xlCell = xlsFile.worksheets("sht-config").cells(curHour*10+curMin\10,
10+curWeekDayNum)

speakContent= " "
If xlSht.Cells(curHour - 8 + 2, 2).Text = "" Then
speakContent = speakContent & xlsFile.Worksheets("default").Cells(1,
3).Value
xlCell.interior.colorindex=7
Else
speakContent = speakContent & xlsFile.Worksheets("default").Cells(1,
6).Value & xlSht.Cells(curHour - 8 + 2, 2).Value
xlCell.interior.colorindex=43
End If

Dim todayContent As String, rw As Integer
todayContent = xlsFile.Worksheets("default").Cells(2, 6).Value
rw = 1
While xlSht.Cells(rw + 1, 3).Text <> ""
todayContent = todayContent &
Left(xlsFile.Worksheets("default").Cells(4, 6).text,1) _
& Str(rw) _
&
Right(xlsFile.Worksheets("default").Cells(4, 6).text,2) _
& xlSht.Cells(rw + 1, 3).Value
rw = rw + 1
Wend
If xlSht.Cells(2, 3).Text = "" Then
todayContent = todayContent & xlsFile.Worksheets("default").Cells(3,
6).Value
End If

Dim minuteContent As String
If xlSht.Cells(curHour - 8 + 2, 2).Text = "" Then
minuteContent = xlsFile.Worksheets("default").Cells(curMin \ 10 + 2,
3).Value
If curMin \ 10 = 4 Then minuteContent = minuteContent & todayContent
Else
minuteContent = xlsFile.Worksheets("default").Cells(curMin \ 10 + 2,
2).Value
End If
If curMin \ 10 = 0 Then
xlSht.Cells(20, 5).Value = curHour
If xlSht.Cells(20, 4).Value = True Then
minuteContent = minuteContent &
xlsFile.Worksheets("default").Cells(5, 6).Value
End If
End If
If curMin \ 10 = 5 Then minuteContent = minuteContent & todayContent

speakContent = speakContent & minuteContent
xlCell.Value = speakContent
xlsFile.Save

End Sub

 

[Mike Glen]

Hi Peter ,

If yo referring to Project vba, then try posting on the developer newsgroup
as this one is closing down. Please see FAQ Item: 24. Project Newsgroups.
FAQs, companion products and other useful Project information can be seen at
this web address:http://project.mvps.org/faqs.htm .

Mike Glen
Project MVP