• 締切済み

VBSでExcelのオープン確認

VBSCRIPTでエクセルに書き込むものを作っているのですが・・・ エクセルが開きっぱなしの場合、同じシートが開いて書き込めなかったりなど有りその対策を考えています。 もし開いていたらMsgBoxを出して終了させてしまおうかと思うのですがエクセルが開いているかどうか確認できません・・・ どのようにしたらよいでしょうか？ wbCount = objExcel.Workbooks.Count msgbox wbCount myFlag = False for i = 1 to wbCount if objExcel.Workbooks(i).Name = strFilename then myFlag = True Exit for end if next if myFlag = True then msgBox "Open" else msgBox "not Open" end if

みんなの回答

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.2

回答１、onlyromです。 回答１で勘違いされるやも知れない文言がありましたので ＞objExcel.Workbooks.Countで取得できるのは、VBSから開いたブックのみでは？ これは先の回答の、Set云々に関係ありますよ、というのを付け加えておきます。 以上。

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.1

　 objExcel.Workbooks.Countで取得できるのは、VBSから開いたブックのみでは？ strFilenameのブックはどうやって開かれてるのか。 VBSからコードで開いているのか、 エクセルから手動で開いているのか？ 開かれてるブックは複数あるのか？ 　 オブジェクト変数objExcelへのSetの部分なども提示の必要あり。 Set objExcel = ＊＊＊＊＊＊＊＊＊ 何れにしろ、そこらあたりのコードの提示、 及び全体の処理の流れの補足があると 的確な回答が寄せられると思います。 　 　

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • エクセル　IF　について！

    UserForm上にTextBoxとコマンドボタンがあり、TextBoxに数字を入れコマンドボタンをクリックすると'A.xlsをセットしてAシートの使用行を格納し検索して他のTextBoxにも反映させていくやり方でマクロを記述しています。そこでTextBoxに入力した数字がない場合はMsgBox”この数字はありません”という形にしたいのですが・・・どのようにすれば良いのか教えて下さい。 If Me.Controls("TextBox1" & Cnt).Value = "" Then MsgBox "呼出したい数字を入力して下さい" Exit Sub End If Set wbMyBook = Workbooks(ThisWorkbook.Name) If MsgBox("以前の記録を呼び戻しますか？", vbOKCancel) = vbOK Then Application.ScreenUpdating = False strMyBookPath = ThisWorkbook.Path If Dir(strMyBookPath & "\" & k1Name) <> "" Then 'あった場合そのブックが空いているか確認する。 flag = False For Each wb In Workbooks '開いていればTrue,開いていなければFalseを設定 If wb.Name = k1Name Then flag = True Exit For End If Next wb 'ブックが開いていなかった場合、ブックを開ける。 If flag = False Then Workbooks.Open strMyBookPath & "\" & k1Name End If Set k1 = Workbooks(k1Name) Set SH1 = k1.Worksheets("Sheet1") Else MsgBox WDName & "が存在していません。設置してください。", vbExclamation, "確認してください" Exit Sub End If lngYcnt_K = SH1.UsedRange.Rows.Count flag = False For lng = 1 To lngYcnt_K If CStr(TextBox1.Text) = CStr(SH1.Cells(lng, 1)) Then flag = True lngNumber = lng Exit For End If Next lng If flag = True Then TextBox3.Value = SH1.Cells(lngNumber, 2) '氏名 End If If SH1.Cells(lngNumber, 3) = "男" Then OptionButton1.Value = True ElseIf SH1.Cells(lngNumber, 3) = "女" Then OptionButton2.Value = True Else OptionButton1.Value = True OptionButton2.Value = False End If MsgBox " 記録を呼び戻しました" Else MsgBox"確認必要"⇒ここにもし数字が違っていたら表示させたいのですが・・・ End If MsgBox " 以前に記録しましたか？" Application.DisplayAlerts = False k1.Close saveChanges:=True Application.DisplayAlerts = True '-------------------------------------------------------------------------- '画面更新ON Application.ScreenUpdating = False End Sub

  • なぜ開かない？

    VBScriptでブラウザからEXCELのシートを開くプロシージャを作りたいのですが、以下のようにしても開けません。ただし、実際に手動でこのEXCELファイルを開くと、「すでに開かれています」とのメッセージが出るので、開かれているけど表示されないといった、おかしな現象が起きていると思われます。どこが間違っているのでしょうか。 Dim objExcel Set objExcel = CreateObject("Excel.Application") sub openExcel Dim objFs Set objFs = CreateObject("Scripting.FileSystemObject") if true = objFs.FileExist("C:\・・ファイル名.xls") Then objExcel.WorkBooks.Open("C:\・・ファイル名.xls") end If end sub

  • VBScriptで自動リンクONでExcelファイルのOpen

    お世話になっております。VBScriptでExcelの既存ブックファイル をオープンさせるのを見よう見真似で作成したのですが、開こうと しているブックに自動リンクが設定されていて、毎回 「開いているブックには、ほかのファイルへの自動リンク・・・・」 と聞かれ「Y」をクリックしています。 希望としてはYを自動で選択してオープンしてくれたらと思っています。 調べてみてUpdateLinkがTrueとか書けばいいように思っていろいろ 試してみたのですがイマイチうまく行きません。 すいませんが教えてもらえませんか？ [Source]------------------------------------------------------- Option Explicit Dim objExcel 'エクセルオブジェクトを作成します Set objExcel = CreateObject("Excel.Application") 'エクセル画面を表示します objExcel.Visible = True 'ワークブックを開きます objExcel.Workbooks.Open "C:\Book1.xls" 'エクセルオブジェクトの破棄 Set objExcel = Nothing

  • FileSearchがエクセル2007で使えなくなって困っています。

    2003では普通に使えたのですが、2007で使うためにはどのように変えればいいのでしょうか？途方にくれているのでVBAに詳しい方ご教授ください。処理文で回答頂けるとうれしいです。 Public Sub p_更新() For i = 1 To 100: gwKillFL(i) = "": Next i With Application.FileSearch .LookIn = gAAFLD .SearchSubFolders = True .Filename = "*T" & Format(gBB, "00") & ".txt" .FileType = msoFileTypeAllFiles If .Execute(SortBy:=msoSortByFileName, _ SortOrder:=msoSortOrderAscending) > 0 Then For i = 1 To .FoundFiles.Count gwKillFL(i) = .FoundFiles(i) Call p_ReadData(.FoundFiles(i)) Next i For i = 1 To .FoundFiles.Count If gwKillFL(i) <> "" Then Kill gwKillFL(i) End If Next i If gMenu1 > 0 Then Range("A2").Select MsgBox "更新", vbOKOnly, "確認" End If Else If gMenu1 > 0 Then MsgBox "更新ファイルなし。", vbOKOnly, "確認" End If End If End With End Sub

  • もしも新規Excelファイルを開いてる場合は閉じる

    Excel2003です・ ユーザーが新規Excelファイル（book1)かテスト用ファイルを開いている場合は閉じる処理を考えております。 Option Explicit Dim ws As Workbook, flag As Boolean Private Sub Workbook_Open() For Each ws In Workbooks If ws.Name = "Book1" Then flag = True Next ws If flag = True Then Workbooks("Book1.xls").Close 　 Else 　 End IF For Each ws In Workbooks If ws.Name = "テスト用.xls" Then flag = True Next ws If flag = True Then Workbooks("テスト用.xls").Close 　 Else 　 End IF End Sub このコードだとBook1を開いているのに、Trueで拾ってくれません。 ws.Name = "Book1.xls"にしても同じです。 どこかおかしい部分があるのでしょうか？

  • 　ＶＢＳの作り方がわかりません

    下記のようなＶＢＳを使いたいのですが 　　テキストでなくエクセルをアクティブにしたいのですがうまくいきません 　　どのように直せばよいのかお教えください。　　お願いいたします。 Dim excel With CreateObject("Wscript.Shell") .Run "D:\DATA\T.txt" End With On Error Resume Next Set excel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set excel = CreateObject("Excel.Application") End If excel.Visible = True excel.Workbooks.Open "D:\DATA\Sin1.xls"

  • ExcelVBAで特定のブックをcloseしたい

    よろしくお願いします。Excel2000ですが、2002,2003,2007でも利用できることを前提に考えています。 　複数のExcelブックを開いているとき、特定のファイル名のブックを閉じる方法を考えています。 　２通り考えたのですが、いずれもだめでした。デバッグ機能でステップインしながら確認したのですが、エラーにもならず、closeメソッドを通過していました。 以下のVBAはなにか誤りがあるのでしょうか？ （その１） 　For i = 1 To Workbooks.Count 　　If Left(Workbooks(i).Name, 2) = "v3" Then 　　　msw = Workbooks(i).Name 　　　If msw <> "V3main.xls" Then 　　　　Workbooks(msw).Close 　　　End If 　　End If 　Next （その２） 　For Each wb In Workbooks 　　If Left(wb.Name, 2) = "v3" Then 　　　MsgBox (wb.Name) 　　　If wb.Name <> "V3main.xls" Then 　　　　With wb 　　　　　.Saved = True 　　　　　.Close 　　　　End With 　　　End If 　　End If 　Next wb

  • vbsのmsgboxランダム表示について

    つい先日、vbsをいじりだしたばかりの初心者です。 このプログラムなんですが・・・ msgbox("冒険はじまりー"),,("冒険") msgbox("てくてく") i = msgbox("分かれ道だ" & vbCrLf & "はい:左 いいえ:真ん中 キャンセル:右",3,"わかれみち") if (i=6) then msgbox("いきどまり") msgbox("ゲームオーバー") elseif (i=2) then msgbox("いきどまり") msgbox("ゲームオーバー") else msgbox("モンスターがあらわれた",48,"バトル") myhp=10 mymp=5 youhp=20 for i=0 to 10 step 0 num=msgbox("ＨＰ(" & myhp & ")" & vbCrLf &_ "ＭＰ(" & mymp & ")" & vbCrLf &_ "モンスターＨＰ　(" & youhp & ")" & vbCrLf &_ "こうげき:はい　かいふく:いいえ まほう:キャンセル",3,"バトル") if(num=6)then myhp = myhp-1 mymp = mymp+1 youhp = youhp-1 msgbox("こうげき！" & vbCrLf &_ "モンスターHP－１" & vbCrLf & "自分のHP－1" & vbCrLf & "自分のMP＋1") elseif (num=7) then myhp = myhp+3 mymp = mymp-3 msgbox"HPが3回復　MPが3減った" else youhp = myhp-2 mymp = mymp-2 msgbox"まほうをつかった MP-2 モンスターHP-2" end if if(youhp=0)then msgbox"モンスターに勝った！",64,"やったね" msgbox"おしまい" exit for elseif(myhp=0)then msgbox"負けた",16,"ざんねん" msgbox"ゲームオーバー",16,"ざんねん" exit for end if next end if これの、攻撃とか魔法とかのところでmsgboxにランダムで違うメッセージを出すことは できますか？（３パターンくらいです） 調べてみても書き方がよくわかりませんでした・・・。 それと、ゲームオーバーの場合、もう一度やるかどうかの選択メッセージの出し方も 教えていただけると嬉しいです。 質問が多くてごめんなさい、どうぞよろしくお願いしますm(_ _)m

  • Excelのブック間の串刺し計算について

    Excelのブック間の串刺し計算について VBA超初心者です。同じフォルダ内にファイルがいくつかあり、同じ形式で、sheet1のB4のセルに計があったとして、それをブック間で串刺し集計したいのですが、うまくいきません。どこが悪いのかもわからず、困り果ててます。ご指導お願いします。 Sub BookShuukei() Dim FileName As String Dim Total As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean FileName = Dir("*.xls") Application.ScreenUpdating = False Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Total = Total + Workbooks(FileName).Sheets(1).Range("B4").Value If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.ScreenUpdating = True MsgBox (Total) End Sub

  • VBSCriptで図形が選択できません

    困っています。 どなたかご教授願えないでしょうか。 実現したいことは、エクセルで作成したファイル「Book1.xlsm」の最初のSheetに配置された図形のうち、名前にFigが含まれるものだけを選択することです。 VBScriptで実現したいものの、「インデックスが境界を超えています」というエラーが出ます。 なお、エクセルマクロではエラーなく実現できました。 環境は以下のとおりです。 OS：Windows7 64bit Excel：2010 以下、VBScriptのコード→ Option Explicit Dim objExcel Set objExcel = CreateObject("Excel.Application") objExcel.Visible = True Dim objWorkbook Set objWorkbook = objExcel.Workbooks.Open("C:\VBSTest\Book1.xlsm") Dim arrShapeMatched() Dim sp Dim i i = 0 For Each sp In objExcel.Sheets(1).Shapes If InStr(sp.Name, "Fig") >= 1 Then ReDim Preserve arrShapeMatched(i) arrShapeMatched(i) = sp.Name i = i + 1 End If Next objExcel.Sheets(1).Shapes.Range(arrShapeMatched).Select 'この文を実行時、インデックスが境界を超えていますというエラーがでます ←以上、VBScriptのコード なお、ほぼ同様のコードをエクセルのマクロで書くとエラーは出ず、意図した通りの結果になります。 以下、マクロに書いたコード→ Sub SelectShape() Dim arrShapeMatched() Dim sp Dim i i = 0 For Each sp In ActiveSheet.Shapes If InStr(sp.Name, "Fig") >= 1 Then ReDim Preserve arrShapeMatched(i) arrShapeMatched(i) = sp.Name i = i + 1 End If Next ActiveSheet.Shapes.Range(arrShapeMatched).Select 'マクロではエラーにならない End Sub ←以上マクロに書いたコード 投稿の都合上、xlsm形式のファイルを読み込んでいますが、実現したい形はマクロが含まれないファイル形式としたいと考えています。 よろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する