0

このコードには、いくつかの Excel オブジェクトと、いくつかのサブルーチンと関数があります。

いくつか編集したところ、何らかの理由でオブジェクトがサブ内で機能せず、"Object Required" エラーが発生しました。

もうどうすればいいのかわからないので、どんな助けでも大歓迎です!

注: 宣言に関する質問がある場合に備えて、コード全体を追加しました...

サブ:

サブ誕生日 (formatDate、i、intRow)

'Take date from database, separate it to days & months
Dim month, day, name
eventDate = Split(formatDate,"/")
month = eventDate(0)
day = eventDate(1)

'Get name of event out of database (one column to the right, from date of event)
name = "netch"

'Get value of row which is used to write events in the specific month
Dim k, row, c
k = 1
wscript.echo objXLCal.Cells(k, 2).Value
Do Until objXLCal.Cells(k, 2).Value = monthRet(month)
    k = k + 1
Loop

'k will be used to find the day column, while row is where the events of that months are written
row = k + 3
c = 1

'Get value of column
Do Until objXLCal.Cells(k,c).Value = eval(day)
    c = c + 1
Loop

'Insert name of event into place
If Asc(name) = 63 Then
    objXLCal.Cells(row,c).Value = StrReverse(name)
Else
    objXLCal.Cells(row,c).Value = name
End If
End Sub

コードの残りの部分:

main("C:\Users\liatte\Desktop\hotFolder\Input")
Function main(argFilePath)

Dim templatePath
'-----------------------------------------------------------------------------
'Path to calendar template
templatePath = "C:\Users\liatte\Desktop\Aviv Omer Neta\Birthdays\Calendar1.xlsx"
'-----------------------------------------------------------------------------

'creates the msxml object
'Set xmlDoc = CreateObject("Msxml2.DOMDocument.6.0")
'Dim retVal

'load the xml data of the script
'retVal=xmlDoc.load(argFilePath)

Dim fso, folder, sFolder, inputFolder, xmlDataPath, curNode

'get input folder
'Set curNode=xmlDoc.selectSingleNode("//ScriptXmlData/inputFilePath")
'inputFolder=CSTR(curNode.text)

'location of input folder
'sFolder=inputFolder
sFolder=argFilePath

'creating file getting object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(sFolder)

'loop that runs on files in input - RUNS JUST ONCE
'For each folderIdx In folder.files

    'Creating object for user excel
    Set objXLBirth = CreateObject("Excel.Application")
    Set objWorkbookBirth = objXLBirth.Workbooks.Open("C:\Users\liatte\Desktop\hotFolder\Input\Birthdays.xlsx")

    'Creating object for calendar template excel
    Set objXLCal = CreateObject("Excel.Application")
    objXLCal.DisplayAlerts = false

    Dim picStr, srcMonth, k, i, intRow, formatDate, txtStr

    'Beginning reading from line 2, skipping header
    intRow = 2

    'loop for each person in user excel
    Do Until objXLBirth.Cells(intRow,1).Value = ""
        i=2

        'Opening the template as new in each round of loop
        Set objWorkbookCal = objXLCal.Workbooks.Open(templatePath)

        'Cover pic
        If Not objXLBirth.Cells(intRow, i).Value = "" Then
            objXLCal.Cells(2, 49).Value = objXLBirth.Cells(intRow, i).Value
        End If

        'Month pic inserter
        For i=3 To 14
            If Not objXLBirth.Cells(intRow,i).Value = "" Then
                picStr = objXLBirth.Cells(1,i).Value
                srcMonth = monthRet(Mid(picStr,4))

                k=1
                Do Until objXLCal.Cells(k, 2).Value = srcMonth
                    k=k+1
                Loop
                objXLCal.Cells(k, 47).Value = objXLBirth.Cells(intRow,i).Value
            End If
        Next

        i=15

        'Cover text inserter
        If Not objXLBirth.Cells(intRow, i).Value = "" Then
            objXLCal.Cells(2, 50).Value = objXLBirth.Cells(intRow, i).Value
        End If

        'Month text inserter
        For i = 16 To 27
            If Not objXLBirth.Cells(intRow,i).Value = "" Then
                txtStr = objXLBirth.Cells(1,i).Value
                srcMonth = monthRet(Mid(txtStr,5))

                k=1
                Do Until objXLCal.Cells(k, 2).Value = srcMonth
                    k=k+1
                Loop
                If Asc(objXLBirth.Cells(intRow, i).Value)=63 Then
                    objXLCal.Cells(k, 48).Value = StrReverse(objXLBirth.Cells(intRow, i).Value)
                Else
                    objXLCal.Cells(k, 48).Value = objXLBirth.Cells(intRow, i).Value
                End If
            End If
        Next

        i=28

        'Birthday inserter
        Do Until objXLBirth.Cells(intRow,i).Value = ""
            formatdate=FormatDateTime(objXLBirth.Cells(intRow,i),2)
            Call birthday (formatdate,i,intRow)
            i=i+2
        Loop

        'saving changed calendar
        objXLCal.ActiveWorkBook.SaveAs "C:\Users\liatte\Desktop\Aviv Omer Neta\Birthdays\Calendar_" & objXLBirth.Cells(intRow, 1).Value & ".txt", 42
        intRow = intRow+1
    Loop

    'moving file to Success
    'fso.MoveFile inputFolder, "C:\Users\liatte\Desktop\Success\"
'Next

objXLBirth.Quit
objXLCal.Quit
End Function

別の機能:

Function monthRet(month)
Select Case month
    Case "1"
        monthRet="January"
    Case "2"
        monthRet="February"
    Case "3"
        monthRet="March"
    Case "4"
        monthRet="April"
    Case "5"
        monthRet="May"
    Case "6"
        monthRet="June"
    Case "7"
        monthRet="July"
    Case "8"
        monthRet="August"
    Case "9"
        monthRet="September"
    Case "10"
        monthRet="October"
    Case "11"
        monthRet="November"
    Case "12"
        monthRet="December"
End Select
End Function

どうもありがとうございました!

4

1 に答える 1

1

次のようなコード レイアウトがあるとします。

Sub birthday (formatDate, i, intRow)
  ...
  wscript.echo objXLCal.Cells(k, 2).Value
  ...
End Sub

Function main(argFilePath)
  ...
  Set objXLCal = CreateObject("Excel.Application")
  ...
End Function

main "C:\Users\liatte\Desktop\hotFolder\Input"

WScript.Echo 行の「オブジェクトが必要です」というエラーが予想されます (main で初期化されたローカル変数 objXLCal は、(したがって) birthday で初期化されていないローカル変数 objXLCal と同じではありません)。

正しい解決策は、"Option Explicit" から始めて、VBScript で適切な手続き型プログラミングの原則に従うDimことですが、トップ/グローバル レベルで objXLCal のような変数をハッキングしても、公開されたコードの品質が低下することはありません。

于 2013-08-07T07:15:04.343 に答える