次の方法で共有

タスクスケジューラーでパスを指定したExcelブック以外を操作出来ない

質問太郎 0 評価のポイント
2024-09-11T01:25:58.1133333+00:00

▶内容
タスクスケジューラーでVBSファイルを経由して指定Excelブック(A)のVBAを毎朝9時に自動で動作させています。
VBAの記述内容として、会計システムからデータをエクスポート、そのデータをコピー、上記の指定Excelブック(A)の指定シートに貼付けをしていますが、タスクスケジューラーが起動する9時の時点で他のExcelブック(B)を開いている場合、エクスポートしたExcelブック(CSVファイル)を見つけることが出来ず、エラーとなってしまいます。尚、タスクスケジューラーの「最上位の特権で実行する」を選択しても実行出来ませんでした。
他のExcelブック(B)を開いていなければ問題なく動作するので、会計システムからデータをエクスポートする前に他のExcelブック(B)などを全て閉じるコードを記述してみたのですが、その部分はスルーされてしまいます。VBSファイルにも同様のコードを記載しましたが、その部分のみスルーされました。タスクスケジューラーではなく、手動で実行すると、他のExcelブック(B)などを閉じるコードはスルーされずに実行されたのでタスクスケジューラーの挙動が何かしらの原因で上手くいっていないものと思われます。記述したコードは下記に記載しておきますが、恐らくタスクスケジューラーで実行する際には指定したパス以外のExcelブックを操作出来ないのかと推測しています。
▶ご教授いただきたいこと
タスクスケジューラーで変数に格納したExcelブック操作する方法(設定方法やコードなど)があれば、どなたかご教授いただけないでしょうか。

【VBSファイルのコード】※太字がタスクスケジューラーで動作しない部分
Const WB_PATH = "C:\Users\US000●●●●\Desktop\タスクスケジューラ\【改修中】支払未処理_ver.2.2.xlsm" ' 起動したいVBAが記述されているExcelのフルパス

Const PROC_NAME1 = "データ出力" ' 起動したいVBA(1)の名前

Dim excelApp

Set excelApp = CreateObject("Excel.Application") ' Excelアプリケーションの新しいインスタンスを作成してセット

With excelApp

.Visible = True ' Excelを表示する(非表示で実行したい場合はFalseに変更)

**' 他のすべてのブックを保存して閉じる**

**' (もし他のExcelブックを開いていたらS4スクリプトでエクスポートしたデータをタイムスケジューラーで操作出来ないので閉じる)**

**Dim wb**

**Dim currentWB**

**For Each wb In .Workbooks**

    **If wb.FullName <> WB_PATH Then**

        **wb.Save ' 他のブックを保存**

        **wb.Close ' 他のブックを閉じる**

    **End If**

**Next**

' 指定されたパス(WB_PATH)のExcelブックを開く

Set currentWB = .Workbooks.Open(WB_PATH)

.Run currentWB.Name & "!" & PROC_NAME1 ' Excelブック(currentWB)に対して指定したマクロ(PROC_NAME1)を実行

.DisplayAlerts = False ' Excelの警告メッセージ(例えばファイルを上書き保存する際の警告)を非表示にする

'currentWB.Save ' 現在開いているExcelブック(currentWB)を保存

'currentWB.Close ' Excelブック(currentWB)を閉じる

End With

'excelApp.Quit ' Excelアプリケーションを終了

【Excelブック(A)のVBAコード】※太字がタスクスケジューラーで動作させた時に他のExcelブックを開いていると動作しない部分
Sub データ出力()

' このエクセルの名前を取得

Dim bookname As String

bookname = ActiveWorkbook.Name



' シート（データ貼付）をクリア

Sheets("データ貼付").Activate

Dim lastRow As Long

lastRow = Sheets("データ貼付").Cells(Rows.Count, "C").End(xlUp).Row

Range("B2:X" & lastRow).ClearContents



' A3セルからA列最終行までクリア

On Error Resume Next

Range("A3:A" & lastRow).ClearContents

On Error GoTo 0



' Y3セルからY列最終行まで入力されている関数のみクリア

On Error Resume Next

Range("Y3:Y" & lastRow).ClearContents

On Error GoTo 0



' Z3セルからZ列最終行まで入力されている関数のみクリア

On Error Resume Next

Range("Z3:Z" & lastRow).ClearContents

On Error GoTo 0



' もしエクスポートしていたらエラーになるので閉じる

On Error Resume Next

Workbooks("Basis (1) の ワークシート").Close False

On Error GoTo 0



'S4を繋ぎに行きます

Dim SapGuiAuto As Object

Dim Application As Object

Dim Connection As Object

Dim session As Object

Set SapGuiAuto = GetObject("SAPGUI")

Set Application = SapGuiAuto.GetScriptingEngine

Set Connection = Application.Children(0)

Set session = Connection.Children(0)



session.findById("wnd[0]").maximize

session.findById("wnd[0]/tbar[0]/okcd").Text = "/n" & "FBL1H"   'トランザクション選択

session.findById("wnd[0]").sendVKey 0

session.findById("wnd[0]/tbar[1]/btn[17]").press

session.findById("wnd[1]/usr/txtV-LOW").Text = "/0099支払チェックA4"    'バリアント選択

session.findById("wnd[1]/usr/txtENAME-LOW").Text = ""

session.findById("wnd[1]/usr/txtENAME-LOW").caretPosition = 0

session.findById("wnd[1]/tbar[0]/btn[8]").press



session.findById("wnd[0]/usr/btn%_S_CCODE_%_APP_%-VALU_PUSH").press

session.findById("wnd[1]/tbar[0]/btn[16]").press

Sheets("トップ").Activate

Range("F9:F18").Select    '会社CD 現在10社まで同時入力可能

Selection.Copy

session.findById("wnd[1]/tbar[0]/btn[24]").press

session.findById("wnd[1]/tbar[0]/btn[8]").press



' 支払期日を設定

session.findById("wnd[0]/usr/ctxtSO_C04-LOW").Text = Sheets("トップ").Range("E5")   'No.2時の日付



' G5セルの内容をチェック

Dim paymentDate As Date

Dim masterSheet As Worksheet

Set masterSheet = Sheets("マスタ")

    

If IsEmpty(Sheets("トップ").Range("G5").Value) Then

    

    ' G5セルが空白の場合はF5セルの値を取得

    paymentDate = Sheets("トップ").Range("F5").Value

Else

    ' G5セルに文字が入力されている場合はマスタの支払日(長期休暇対応支払日の最大値)を取得

    Dim lastRowMaster As Long

    Dim cell As Range

    Dim maxDate As Date

    Dim dateFound As Boolean

    Dim searchDate As String

    Dim rDate As String

    

    lastRowMaster = masterSheet.Cells(masterSheet.Rows.Count, "R").End(xlUp).Row

    maxDate = 0

    dateFound = False

    

    ' F5セルの日付をフォーマット

    searchDate = Format(Sheets("トップ").Range("F5").Value, "yyyy/m/d")

    

    For Each cell In masterSheet.Range("R2:R" & lastRowMaster)

        

        ' R列の日付をフォーマットして比較

        rDate = Format(cell.Value, "yyyy/m/d")

        If rDate = searchDate Then

            If cell.Offset(0, 1).Value > maxDate Then

                maxDate = cell.Offset(0, 1).Value

                dateFound = True

            End If

        End If

    Next cell

    

    ' 一致する日付が見つかった場合のみ paymentDate を更新

    If dateFound Then

        paymentDate = maxDate

        

        ' トップシートのA2に取得した値を入力

        Sheets("トップ").Range("A2") = maxDate

        

        ' トップシートのA3セルの日付を設定

        session.findById("wnd[0]/usr/ctxtSO_C04-HIGH").Text = Sheets("トップ").Range("A3") '支払の日付

    Else

        ' 一致しない場合はF5セルの日付を設定

        session.findById("wnd[0]/usr/ctxtSO_C04-HIGH").Text = Sheets("トップ").Range("F5")  '支払の日付

    End If

    

End If



session.findById("wnd[0]/usr/ctxtSO_C04-HIGH").SetFocus

session.findById("wnd[0]/usr/ctxtSO_C04-HIGH").caretPosition = 10

session.findById("wnd[0]/tbar[1]/btn[8]").press

session.findById("wnd[0]/usr/tabsTABSTRIP/tabpTAB3/ssubSUB3:SAPLPIVB:1030/cntlCCONTROL_ACTIONS/shellcont/shell/shellcont[1]/shell[1]").hierarchyHeaderWidth = 755

session.findById("wnd[0]/usr/tabsTABSTRIP/tabpTAB3/ssubSUB3:SAPLPIVB:1030/cntlCCONTROL_ACTIONS/shellcont/shell/shellcont[1]/shell[1]").topNode = "          1"

session.findById("wnd[0]/shellcont/shell").pressToolbarButton "SHOWBUT"

session.findById("wnd[0]/shellcont/shell").pressToolbarContextButton "&MB_EXPORT"

session.findById("wnd[0]/shellcont/shell").selectContextMenuItem "&XXL"

session.findById("wnd[1]/tbar[0]/btn[20]").press

session.findById("wnd[1]/tbar[0]/btn[0]").press

session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[0,0]").Select

session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[0,0]").SetFocus

session.findById("wnd[1]/tbar[0]/btn[0]").press

session.findById("wnd[1]/tbar[0]/btn[0]").press

**' エクスポートされたブックを探す**

**Dim exportBook As Workbook**

**Dim wb As Workbook**

**Dim found As Boolean**



**' すべての開いているワークブックの名前を確認**

**For Each wb In Workbooks**

    **If wb.Name Like "Basis*" Then**

        **Set exportBook = wb**

        **found = True**

        **Exit For**

    **End If**

**Next wb**



**' エクスポートされたブックが見つかった場合の処理**

**If found Then**

    **exportBook.Activate**

    **' コピー元シートをアクティブにする**

    **exportBook.Sheets(1).Activate**

    **' データをコピー**

    **exportBook.Sheets(1).Range("A1").CurrentRegion.Copy Workbooks(bookname).Sheets("データ貼付").Range("B1")**

    **exportBook.Close False**

**Else**

    **MsgBox "エクスポートされたブックが見つかりません。"**

**End If**

' C列の最終行取得

Sheets("データ貼付").Activate

Dim lastRow2 As Long

lastRow2 = Sheets("データ貼付").Cells(Rows.Count, "C").End(xlUp).Row



' A2セルからC列の最終行数までA列セルをオートフィル

Range("A2").AutoFill Destination:=Range("A2:A" & lastRow2)

' A列を値に変換

Range("A3:A" & lastRow2).Value = Range("A3:A" & lastRow2).Value

    

' Y2セルからC列の最終行数までY列セルをオートフィル

Range("Y2").AutoFill Destination:=Range("Y2:Y" & lastRow2)



' Z2セルからC列の最終行数までZ列セルをオートフィル

Range("Z2").AutoFill Destination:=Range("Z2:Z" & lastRow2)

' Z列を値に変換

Range("Z3:Z" & lastRow2).Value = Range("Z3:Z" & lastRow2).Value



' 元のブックに戻る

Sheets("トップ").Activate

Range("A1").Select

Calculate

End Sub

Windows 10
Windows 10
パーソナル コンピューターとタブレットで実行される Microsoft オペレーティング システム。
100 件の質問
0 件のコメント

1 件の回答

並べ替え方法: 最も役に立つ
最も役に立つ 新しい順 古い順
  1. gekka 9,666 評価のポイント MVP
    2024-09-11T08:52:36.3366667+00:00

    GetObjectではなくCreateObjectをつかっているので、CreateObjectをするたびにタスクマネージャーのプロセス表示にExcelが増えてませんか？

    異なるプロセスにあるワークブックを認識・操作することはできません。
    つまり既に起動済みのExcelのワークブックを操作できないので、起動済みExcelで作業中のワークブックを基にしたエクスポートCSVも見えなくなっているのでは？

    Dim xla 'As Excel.Application
Set excelApp = GetObject(, "Excel.Application") '既に起動されているExcelアプリケーションがあれば、そのインスタンスをセット
If excelApp Is Nothing Then
    Set excelApp = CreateObject("Excel.Application") ' 起動されていなければ、Excelアプリケーションの新しいインスタンスを作成してセット
End If

    #SAPGUIが原因だとしたら試せません

    0 件のコメント

お客様の回答

回答は、質問作成者が [承諾された回答] としてマークできます。これは、ユーザーが回答が作成者の問題を解決したことを知るのに役立ちます。