• 締切済み

ExecuteExcel4Macroでのデータ取得

office365 従来、ドメイン配下のサーバに登録されているファイルをExecuteExcel4Macroでファイルを開かずにセルの値を抽出していました。 今回、サーバがドメイン配下でなくなったので参照ツールを変更しようとしています。 サーバ名が○○○○ IDがID パスワードがPW で Gドライブのinフォルダに登録されてる ファイル名:A001.xslsm シート名 :1_001_01 セルアドレス:A1 の内容を refer.xslmファイルのセルアドレスR1にExecuteExcel4Macroで表示させるマクロをベタで教えていただきたく。 ExecuteExcel4Macroでデータ抽出する構成にしているのは、参照するファイル容量が大きいので、 ファイルを開いてコピペ方式だとレスポンスが悪いからです。 サーバにはリモートディスクトップ接続をバッチファイルで起動したら入れる様にはなってます。 kido.batの中身 @echo off Set SERVER=○○○○ Set USERNAME=ID Set PASSWORD=PW Cmdkey /generic:TERMSRV/%SERVER% /user:%USERNAME% /pass:%PASSWORD% Start mstsc /v:%SERVER% Timeout 3 Cmdkey /delete:TERMSRV/%SERVER% kido.batを起動するマクロは下記 Sub RunBatShell() Dim dProcessId As Double Dim sPath sPath = "C:\Users\ID\Desktop\kido.bat" dProcessId = Shell(sPath) End Sub 上記バッチ内容もマクロに記述出来たら1本化したく。

みんなの回答

  • HohoPapa
  • ベストアンサー率65% (454/690)
回答No.2

batファイルの完了を待って、後続の処理が走るようにしたい。 ということと理解しました。 以下のようなアイディアはいかがでしょうか。 ・チェック用ファイルを削除する ・batファイルを実行する ・その終盤でチェック用ファイルを作成する ・500ms間隔でチェックファイルの有無を確認する ・これを20回繰り返しても見つからなければタイムアウトさせる ・作成されたことが確認出来たら後続に進む これらを組み込んだのが以下のコードです。 詳しくはコードを読んでください。 kido.batの中身 ここから================= @echo off Set SERVER=○○○○ Set USERNAME=ID Set PASSWORD=PW Cmdkey /generic:TERMSRV/%SERVER% /user:%USERNAME% /pass:%PASSWORD% Start mstsc /v:%SERVER% Timeout 3 Cmdkey /delete:TERMSRV/%SERVER% echo ABC > D:\TestDir\VBAandBAT\Check.txt kido.batの中身 ここまで================= vba===================== Option Explicit Sub Sample()  Dim fso As FileSystemObject  Dim dProcessId As Double  Dim sPath  Dim i As Long  Set fso = New FileSystemObject ' インスタンス化  i = 0    'チェック用ファイルを削除  On Error Resume Next  Call fso.DeleteFile("D:\TestDir\VBAandBAT\Check.txt", True) ' 指定したパスのファイルを削除  On Error GoTo 0  'バッチファイルの実行  sPath = "D:\TestDir\VBAandBAT\Kido.bat"  dProcessId = Shell(sPath)      'バッチファイルの終了を待つ  Do   If i > 20 Then    MsgBox "タイムアウト"    Exit Sub   End If      MySleep      If FileExists("D:\TestDir\VBAandBAT\Check.txt") = True Then    Exit Do   End If   i = i + 1  Loop    On Error Resume Next  Call fso.DeleteFile("D:\TestDir\VBAandBAT\Check.txt", True) ' 指定したパスのファイルを削除  On Error GoTo 0     '継続処理   MsgBox "後続処理開始"      ' 後始末  Set fso = Nothing End Sub '//---------500msの待ち Sub MySleep()   Dim time As Long   time = 500      Application.Wait [Now()] + time / 86400000 End Sub '//---------ファイル有無判定関数 Function FileExists(ChkFile As String) As Boolean  FileExists = True  On Error GoTo ErrorHandler     ' エラー処理ルーチンを定義  FileDateTime (ChkFile)  On Error GoTo 0          ' エラーのトラップを無効にします。  Exit Function           ' エラー処理ルーチンが実行されないように Sub を終了 ErrorHandler:            ' エラー処理ルーチン  FileExists = False  Resume Next End Function

  • HohoPapa
  • ベストアンサー率65% (454/690)
回答No.1

ドメイン所属のユーザを使って認証を通したい ということであれば、 未確認ですし、当てずっぽうですが、 Set USERNAME=ID このIDの部分を ドメイン名と"\"とidの文字列の文字列にすれば いけるんじゃないかと思います。 DomABC\Yamada_Taro といった文字列です。

3620313
質問者

補足

回答ありがとうございます。 ちょっと説明不足でした。 ドメイン所属のユーザを使って認証を通したい ではなく 現状ドメイン配下で ディスクトップにある参照.xlsmというファイルを実行して ドメイン配下にないg:\inフォルダに登録されてる ファイル名:A001.xslsm シート名 :1_001_01 セルアドレス:A1 を抽出したいのです。 参照.xlsmの中身が sub test() Range("A1") = ExecuteExcel4Macro("'G:\in\[A001.xlsm]1_001_01'!R1C1") end sub だと、この参照.xslmをkido.batで開いたディスクトップにコピーしtestのマクロを起動すると Aにデータ抽出できます。 なので、下記イメージかと思ってるのですが、下記を実行するとkido.batが走る前にドキュメントフォルダでファイルを指定する表示状態になった後にkido.batが走るという?な状況になってます。 sub chushutsu() kido Range("A1") = ExecuteExcel4Macro("'G:\in\[A001.xlsm]1_001_01'!R1C1") end sub

関連するQ&A

  • ExecuteExcel4Macroでセル値取得

    office2010 あるフォルダにファイルを入れて、ファイルを開かずに対象シートの対象セルの値を取得したいです。 この取得したいセル情報を、変数で指定したいのです。 C:\dataに取得元のファイルが入っています。 このファイル名((1))は、いろいろ変わりますが、中にH4という文字があります。 対象シートのシート名とセルアドレスは、別のファイル(これにマクロがあります) のsettingシートで指定します。 1例ですが、settingシートの B2に11_001 C2にAF9 と設定します。 (1)のファイルで11_001というシートのAF9セル値を取得したいのです。 Dim myPath As String Dim myFile As String myPath = "C:\data\" myFile = Dir(myPath & "*H4*.xlsm") Dim sheetname As String Dim cell As String sheetname = Worksheets("setting").Range("B2") cell = Worksheets("setting").Range("C2").Value ' 'Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!R9C32") Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!" & cell & "") 上記で、 Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!R9C32") は、値取得できます。 このR9C32を変数にする所で、エラーが発生します。 実行時エラー1004と。 いろいろWEB見て、’,スペース等を入れてみましたが、どうしても分からず、 Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!" & cell & "") の最後のセル指定を、変数で設定する方法を教えて頂きたく。

  • 【VBA】ExecuteExcel4Macro

    こんにちは、VBA初心者につき皆様のお知恵をお貸し下さい。 ExecuteExcel4Macroを使用し同一フォルダ内の複数ブックから値の取得を行う際に 特定のブックが開かれている(使用中)場合、それを判断する方法はありますでしょうか? 当初は以下プログラムで判断していたのですが ファイル数が多い為1つ1つ開いてしまうととても処理時間が掛かるので 試行錯誤しながらExecuteExcel4Macroにたどり着きました。 ------------------------------------------------------------------------------------------- Set wb = Workbooks.Open(myFdr & "\" & fname)  If ActiveWorkbook.ReadOnly Then   MsgBox "取得できませんでした"   ActiveWorkbook.Close   Exit Sub  End If -------------------------------------------------------------------------------------------- 処理速度が早く出来るのであればExecuteExcel4Macroに拘りは無いので もし他にいい手段がありましたらご教授頂けると幸いです。 以上、宜しくお願い致します。

  • VBAでのExecuteExcel4Macroの値取得でエラー

    こんにちは。 Excel VBAより、ExecuteExcel4Macroを実行して、 外部のExcelファイルの、名前(店名、月度)を定義したセルの値を取得したいと思っています。 店名:文字列型 月度:Date型 そこで、ExecuteExcel4Macro()を実行し、以下のような処理を加えました。 ------------------------------------------------------------------------------------ dim 店名 as Variant, 月度 as Variant If 外部マクロ実行("'c:\[test.xls]出勤簿'!店名", 店名) = False Or _ 外部マクロ実行("'c:\[test.xls]出勤簿'!月度", 月度) = False Then MsgBox "取得失敗", vbExclamation End End If Public Function 外部マクロ実行(com As String, ByRef result As Variant) As Boolean On Error GoTo erron3 result = ExecuteExcel4Macro(com) On Error GoTo 0 外部マクロ実行 = True Exit Function erron3: 外部マクロ実行 = False End Function ------------------------------------------------------------------------------------ これを実行したところ、「月度」の値は取得できるのですが、 「店名」の値には「エラー 2042」という値が入ります。 ※dirname, filenameは正しい値が入っています。 ※シート「出勤簿」および「月度」「店名」のセル名の定義も存在します。 test.xlsを開いてるときは、上記の現象は起こらず、 「店名」の値は正常に取得できます。 また、試しに、test.xlsを開き、 Worksheets("出勤簿").Range("店名")を実行すると、正常な値が取得できました。 まとめると、 ・閉じたブックの、あるシートにある、セルに定義された名前を指定して ・ExecuteExcel4Macroで、文字列が入っている値を取得しようとした時、 ・正常に値が取得できない という現象に遭遇しています。 3日ほど調べているのですが、どうしても原因が分かりません。 解決策をお持ちの方、いらっしゃいましたらアドバイスを頂けると助かります。 環境:WindowsXP Pro SP3 Excel 2003 (11.5612.5606) 以上、よろしくお願いいたします。

  • Excel VBAのApplication.ExecuteExcel4Macro

    こんにちは。 Excel VBAでファイル間集計のマクロを作りました。 変数MyStrに指定のパスとファイル名を代入するようにしてあります。 Application.ExecuteExcel4Macro(MyStr) を実行し指定のパスにファイル名が実在すれば、動作は上手くいきます。 ただし、指定のパスにファイルが存在しない場合、ファイル検索のダイアログが出てしまい、強制終了すれば、実行時エラー2023になってしまいます。 これを回避し、「該当のファイルが見つかりません」とメッセージを出したいのですが、IF文にどのように書けばいいのか分かりません。 参考サイトでも、構いませんので皆さんの知恵を貸して下さい。 よろしくお願いします。

  • ExecuteExcel4Macroを使ったレコードの読み込み方法につ

    ExecuteExcel4Macroを使ったレコードの読み込み方法について 下記サンプルは、ファイルを指定して、指定したファイルの中にあるシートを選択し、その中にあるデータを読込むものになっています。 読込ませるファイルのsheet1には、『 ID,顧客番号,氏名,住所,電話番号 』 が入っています。 下記サンプルでは、顧客番号フィールドのデータは読込めるのですが、該当するレコード全体を読込むにはどう組み立てればいいかよくわかりません。 すみませんが、どなたかご教授いただけませんでしょうか。よろしくお願いいたします。 Public Sub testes() ' 変数の指定 Dim OpenFileName, SheetName, Target, buf As String Dim i, TargetCol As Long, GetNames() ' 対象ブックの選択 OpenFileName = Application.GetOpenFilename("Microsoft Excel ブック,*.xls") If OpenFileName = "False" Then Exit Sub ' ファイル名に[]を付ける OpenFileName = Replace(OpenFileName, Dir(OpenFileName), "[" & Dir(OpenFileName) & "]") ' 対象ワークシート名の指定と取得 SheetName = InputBox("対象ワークシート名を入力します") If SheetName = "" Then Exit Sub Target = "'" & OpenFileName & SheetName & "'!" ' ワークシートの正誤チェック On Error Resume Next buf = ExecuteExcel4Macro(Target & "R1C1") If Err <> 0 Then MsgBox "ワークシート [ " & SheetName & " ] を読めませんので終了します。", vbExclamation Exit Sub End If On Error GoTo 0 ' [顧客番号]フィールドを探す For i = 1 To 256 If ExecuteExcel4Macro(Target & "R1C" & i) = "顧客番号" Then TargetCol = i Exit For End If Next i If TargetCol = 0 Then MsgBox "[顧客番号]フィールドが確認できません。", vbExclamation Exit Sub End If ' データの読み込み For i = 1 To 10000 buf = ExecuteExcel4Macro(Target & "R" & i) If buf = "0" Then Exit For ' シートに出力する Worksheets("sheet3").Activate ActiveSheet.Cells(i, 1) = buf Next i End Sub

  • Excel VBA ExecuteExcel4Macroについて

    こんにちは。よろしくお願いします。 あるフォルダ"D:\test"のなかに、4つのxlsファイル"o.xls"、"a.xls"、"b.xls"、"c.xls"があるとします。 使用するシート名は、それぞれo,a,b,c(ファイル名から".xls"を除いたもの)とします。 このとき"o.xls"を開いて、下記のマクロを実行すると、1行目にパス名、2行名にファイル名、3行目以下に(1列目は"a.xls"の、2列目は"b.xls"の、3列目は"c.xls"の)セルA3以下が読み込まれます。 たとえば、結果は添付の図のようになります。図がうまくアップできなかったらごめんなさい。 Sub sample1() Application.Calculation = xlManual Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next Worksheets("o").Cells.Clear Dim p As String, fn As String, fc As Long, i As Long, j As Long, d, e p = ActiveWorkbook.Path fn = Dir(p & "\" & "*.xls", 0) fc = 0 If fn <> "" Then fc = fc + 1 For j = 3 To 6 With Worksheets("o") .Cells(1, fc).Value = p & "\" & fn .Cells(2, fc).Value = fn d = ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R" & j & "C1") If d = 0 Or IsError(d) Then Exit For Else .Cells(j, fc) = d End If End With Next j End If Do fn = Dir() If fn <> "" Then fc = fc + 1 For i = 3 To 6 With Worksheets("o") .Cells(1, fc).Value = p & "\" & fn .Cells(2, fc).Value = fn e = ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R" & i & "C1") If e = 0 Or IsError(d) Then Exit For Else .Cells(i, fc) = e End If End With Next i Else Exit Do End If Loop Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlAutomatic End Sub 上記の例は変数iとjが3から6までしか動きませんし、読み込むxlsファイルも3つしかありませんのですぐに終わりますが、実際には行やファイルがもっとたくさんあり、非常に時間がかかっています。そこで、 ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R" & i & "C1") を e = ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R3C1:R6C1") というような風にして、For~Nextも使用せず .range(Cells(3, fc),cells(6, fc)) = e というふうに範囲で読み込もうとしたのですがうまくいきません。 ExecuteExcel4Macroは範囲を読み込むことはできないのでしょうか? 何とかして処理速度を上げたいのですが、どうすればよいでしょうか。

  • Excel VBA でExecuteExcel4Macro("GET.OBJECT(48,

    エクセル2000です。 以前、ワークシートに配置したフォームツールのラベルの参照元を取得するマクロをご教示いただき、以下のTest01は問題なく作動しています。 Sub test01() Dim obj As Object Dim i As Integer Dim obj_n As String 'オブジェクトの名前 With ActiveSheet For Each obj In .Labels i = i + 1 .Cells(i, 2) = obj.Name: obj_n = obj.Name .Cells(i, 3) = obj.TopLeftCell.Address 'GET.OBJECT で、リンクがないものを取ると、False になる .Cells(i, 5) = ExecuteExcel4Macro("GET.OBJECT(48,""" & obj_n & """)") .Cells(i, 6) = obj.OnAction Next End With End Sub 今回、同一シートではなく別シートに表示させようと以下のTest02を書いたのですが、やってみると .Cells(i, 5) はすべて#VALUE!エラーになってしまいました。 ExecuteExcel4Macro("GET.OBJECT(48~がどのようなものかわからずやっているので応用がききません。(そもそも48って?) どのようになおしたらよいのかご教示いただければ幸いです。 Sub test02() Dim obj As Object Dim i As Integer Dim obj_n As String Dim ws As Worksheet, ns As Worksheet Set ws = ActiveSheet Set ns = Worksheets.Add With ns For Each obj In ws.Labels i = i + 1 .Cells(i, 2) = obj.Name: obj_n = obj.Name .Cells(i, 3) = obj.TopLeftCell.Address .Cells(i, 5) = ExecuteExcel4Macro("GET.OBJECT(48,""" & obj_n & """)") .Cells(i, 6) = obj.OnAction Next End With End Sub

  • Accessからバッチ処理を実施し、作成したデータを取り込む処理

    お世話になっております。 題名の件ですが、 ▼Accessマクロ Function EventQuery() Dim objWSH As Object Set objWSH = CreateObject("WScript.Shell") objWSH.Run """C:\Documents and Settings\userName\デスクトップ\EventLogAccess\event.bat""" Set objWSH = Nothing End Function 上記マクロで、event.batというバッチ処理を実行しております。 ▼event.bat set fname=%DATE:/=% eventquery /s server /u userName /p passWord /l application /fi "Id eq 8" /fi "Datetime gt 12/04/2009,01:00:00AM" /r 500 /v >%fname%.txt 上記バッチ処理で、2009年12月4日のイベントログ(アプリケーション)の一覧を取得しております。 【質問内容】 eventquery.vbsのオプションでは日付指定しかできないみたいですが、 実行した当日のログ(アプリケーション)を取得したいと考えております。 方法はないでしょうか? ご教示の程宜しくお願い致します。

  • wget でのファイル取得

    FTPサーバから、ファイルを取ってこなければならなくなったのですが、サーバ上のファイル名に「日本語」がついています。 Windows の FFFTP では、普通に日本語のファイル名が表示されています。サーバはWindowsのようです。 [xxxxx@xxxxxx Aug]$ ftp ftp.foo.co.jp Connected to ftp.foo.co.jp. 220 Microsoft FTP Service <SNIP!> Name (ftp.foo.co.jp:username): username 331 Password required for username. Password: 230 User username logged in. Remote system type is Windows_NT. ftp> というような表示です。 で、ダウンロードするファイルが多い(10GBのオーダー)なので、wgetで一気に取得しようとしたのですが、うまく取得できません。 ダウンロードするホストのOSはCentOSで日本語が表示されている(LANG=ja_JP.UTF-8)状態です。 ここで wget --no-passive-ftp -nH -np -r ftp://username:password@ftp.foo.co.jp/ と実行すると、index.htmlが生成され、ファイルはダウンロードされません。ファイルはそのまま見ると文字化けするのですが、lvでUTF8に変換するとディレクトリ名などが正常に確認できます。 なぜ、ファイルがダウンロードされないのでしょうか?

  • タスクスケジューラで表示されるアプリの最小化

    Windows10 office2016 excelマクロであるアプリ(A)を起動する上で、もともと何かしらのアプリ画面が表示されていると邪魔な場合があります。 なのでタスクスケジューラで表示されているアプリを最小化して (A)を起動する構成にしたいです. 下記は(A)を起動するマクロの部分 With CreateObject("Wscript.Shell") .Run "c:\work\kido.bat", 5 End With これを実行する前にbatファイル(close.bat)を起動して最小化したい With CreateObject("Wscript.Shell") .Run "c:\work\close.bat", 5 End With With CreateObject("Wscript.Shell") .Run "c:\work\kido.bat", 5 End With こんな構成のイメージかと思っています。 このclose.batの中身あるいは、マクロ文で可能なら、それでもかまいません。 よろしくお願いします。

専門家に質問してみよう