peoplesoft からレポートを抽出するために使用する実際の作業コード。コードは、インターネットでさまざまなブログやコード ベースを検索して作成されました。
コードは、開始日と終了日などのデータ範囲をループし、抽出を生成します。Psoft は抽出で 65,000 行を超える行を提供できないため、これを一度に 7 日間実行するようにしました。
Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal HWND As Long) As Long
Sub PPS_Report_Extractor()
Dim Cell, Rng As Range 'Declaring cell for looping thru date range
'Dim appIE As Object 'InternetExplorer.Application
Dim appIE As InternetExplorer
Dim sURL As String 'URL String
Dim Element As Object 'HTMLButtonElement
Dim btnInput As Object 'MSHTML.HTMLInputElement
Dim ElementCol As Object 'MSHTML.IHTMLElementCollection
Dim Link As Object 'MSHTML.HTMLAnchorElement
Dim Counter, myNum 'Add Counter
Counter = 0 'Declare Start for Counter
myNum = 147 'Declare the number of repitition required
RemNamedRanges 'Delete the older ranges
'---Set New Range of reporting start dates -----
Range("A1").Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Name = "ElementCol"
Set Rng = Worksheets("Sheet1").Range("Elementcol")
'---Launch the IE -----
' Set appIE = CreateObject("InternetExplorer.Application")
Set appIE = New InternetExplorerMedium
sURL = "" ' open the URL by loggin intot PPS query then past that url here
appIE.Navigate sURL
appIE.Visible = True
'While appIE.Busy
' DoEvents
'Wend
Pause (5) 'Allow IE to load
SendKeys "{ENTER}" 'Hit log on button in IE
'-Loop to generate the Files for full year starts here ---
For Each Cell In Rng
A = Format(Cell.Value, "DD-MM-YYYY")
B = Format(Cell.Offset(0, 1).Value, "DD-MM-YYYY")
'----Code for extraction ---START---
Application.Wait Now + TimeValue("00:00:5")
'Pause (5) 'Allow IE to load
appIE.Document.getelementbyid("InputKeys_bind2").Value = A
appIE.Document.getelementbyid("InputKeys_bind3").Value = B
appIE.Document.getelementbyid("#ICQryDownloadExcelFrmPrompt").Click
Pause (5)
SendKeys "{ENTER}", 5
'---Wait for excel generation to complete
I = 0
Set fo = CreateObject("Scripting.FileSystemObject")
Do Until fo.FileExists(OutFile) 'Loop until the output file is created, this could be infinity if there is a problem
Application.Wait (Now + TimeValue("0:00:2")) 'Holds the program for 2 seconds
DoEvents
I = I + 1
If (I = 10) Then
SendKeys "%S" 'Alt S to save the report
GoTo 1
End If
Loop
1
'----Code for extraction ---END---
Next Cell
'-Loop to generate the Files for full year Ends here here ---
MsgBox "The range has " & K & " rows."
End Sub