none
在Office和Automate两种软件中用vba编程,暴露的activex设置问题 RRS feed

  • 常规讨论

  •  

    版上各位专家好,

     

    首先介绍Automate软件,它是一个强大的自动化软件,拥有大量的触发条件和反应动作,网址是http://www.networkautomation.com/ 。它也支持vba编程。小弟最近在一个Automate Task中写了一段vba代码,涉及对excel文件的操作。

     

    运行结果如下:在我的笔记本电脑上,用automate执行那段代码,到了第93行“xlApp.Workbooks.Open (filePath & "ThisWeek.xls")”,就会出错。错误信息是Script error: "(10090) ActiveX Automation error."

    还是在我的笔记本电脑上,把那段vba代码复制到Office系列的word、excel、outlook的任一个宏里,可以运行成功。

    换一台电脑,同样的操作系统、同样的Office2003和Automate软件,也可以运行成功!

     

    大致的结论是:我的笔记本电脑上的activex配置大概有毛病。可是具体的毛病在哪里,我怎么更正它,让automate里的vba代码能够运行? 希望专家们能提供一种方法,让我比较两台电脑上activex配置的异同,也许能发现根本的原因。

     

    ————————————————————————————————————————

    附上我的vba代码。

     

    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

    2008年9月4日 6:39