VBAでの共有ファイル操作

このQ&Aのポイント
  • VBAを使用して別のパソコン上の共有ファイルを操作する方法について説明します。
  • 共有フォルダ内の同名ファイルを上書きコピーする方法についても説明します。
  • 複数のパソコンがアクセスする場合の処理についても考慮しています。
回答を見る
  • ベストアンサー

VBAでの共有ファイル操作

エクセルVBAを使い別のBOOKを開きたいのですがそのファイルはLANで接続された別のパソコンに入っています。 With Application.FileSearch .LookIn = acpath .Filename = "日記" & TextBox1.Value & ".xls" If .Execute > 0 Then Workbooks.Open Filename:=acpath & "\日記" & TextBox1.Value & ".xls" Else MsgBox "アクセスできませんでした。" Exit Sub End If End With MsgBox "アクセス成功" パスは変数にしています。 こんな感じで現在ファイルを開いているのですが、5台位のパソコンがそのファイルにアクセスする場合別のパソコンが使用していることもあります。このとき別のパソコンが使用している場合は何かメッセージをだし(例えば「しばらくして実行してください」)実行しているプログラムから抜けたいのですが、できるのでしょうか? もう1つはその共有フォルダー内に同じ名前のファイルを上書きコピーしたいのですが、「上書きしますか?}みたいなメッセージを表示させずに強制的に上書きさせることはできるのでしょうか?よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.1

こんにちは。 > 別のパソコンが使用している場合は何かメッセージをだし... こんな感じの関数を標準モジュールに作成して、 ' // ファイルが編集可能か調べる Public Function IsFileEditable( _     ByVal FilePath As String _ ) As Boolean   Dim n  As Integer      IsFileEditable = False      If CreateObject("Scripting.FileSystemObject") _     .FileExists(FilePath) = False Then     Exit Function   End If      n = FreeFile()   On Error Resume Next   Open FilePath For Binary Lock Read Write As #n   Close #n   IsFileEditable = CBool(Err.Number = 0)   On Error GoTo 0 End Function 次のように確認すれば良いと思いますよ。   sPath = acpath & "\日記" & TextBox1.Value & ".xls"   If IsFileEditable(sPath) Then     ' MsgBox "編集可能", vbInformation     Workbooks.Open Filename:=sPath   Else     MsgBox "ファイルは使用中です。" & vbLf _        & "しばらくして実行してください", vbCritical     Exit Sub   End If > 「上書きしますか?」みたいなメッセージを表示させずに強制的に > 上書きさせることはできるのでしょうか   Application.DisplayAlerts = False   ’(上書き処理)   Application.DisplayAlerts = True でアラートの表示は停止できます。 ただし、自分以外の誰かが編集中のファイルについて、もし何らかの 手段で無理やり「上書き」できたとしても、ファイルが破損してしまう 可能性が非常に高いです。 先述の IsFileEditable 関数などの手段を使って、予めファイルが 使用中でないことを確認して条件分岐させた方が良いでしょうね。。

takedono
質問者

お礼

本とか見ながらやっているのですがこのようなことまでは書いてなかったので助かりました。ありがとうございます。

関連するQ&A

  • 【ExcelVBA】指定したファイル名をAドライブで検索

    エクセルVBAで、指定したファイル名のファイルをAドライブ直下で検索した場合、ワイルドカードを使ってないにも関わらず、ワイルドカード検索みたいな感じで結果がとれてしまいます。 ■Aドライブ直下 aaaPROFILE.xls testPROFILE.xls ■コード With Application.FileSearch .NewSearch .LookIn = "A:\" .SearchSubFolders = True .Filename = "PROFILE.xls" If .Execute() > 0 Then MsgBox Application.FileSearch.FoundFiles(1) & "あった" Else MsgBox "Aドライブに[PROFILE.xls]を保存してね" End If End With これを実行すると、「Aドライブに[PROFILE.xls]を保存してね」というメッセージが出てほしいのですが、「aaaPROFILE.xlsあった」とでてきてしまい、aaaPROFILE.xlsが検索結果にひっかかってしまいます。 これは何故でしょうか?どうしたら指定した文字列をビタで検索できるでしょうか? ご回答よろしくお願いいたします。

  • エクセル VBAのチェックボックスについて

    お読みくださり、ありがとうございます。 エクセル初心者でございます。 エクセルのマクロなのですが、 お詳しい方、是非教えて欲しいです!汗 調子に乗って入力フォームなるものを作りました。 入力フォームの中にて、チェックボックスで「ある」「なし」の項目を入れてみたのですが、チェックしていないのに、値が入る現象が起きています汗 以下、素人が書いたコードを恥を承知で記載させていただきます。 Private Sub CheckBox1_Click() If CheckBox1.Value = True Then OK = "○" End If End Sub Private Sub CheckBox2_Click() If CheckBox2.Value = True Then NO = "×" End If End Sub Private Sub UserForm_Click() End Sub '以下のコードは、登録ボタンがクリックされたときの処理! Private Sub 登録ボタン_Click() If TextBox1.Text = "" Then MsgBox "グッズ名を入力してください。" Exit Sub End If If TextBox2.Text = "" Then MsgBox "アプローチ先を入力してください。" Exit Sub End If With Worksheets("協賛グッズ") With Cells(Rows.Count, 2).End(xlUp) .Offset(1, 0).Value = TextBox1.Text .Offset(1, 1).Value = mori .Offset(1, 2).Value = mori2 .Offset(1, 3).Value = TextBox2.Text .Offset(1, 5).Value = TextBox3.Text .Offset(1, 6).Value = TextBox4.Text .Offset(1, 7).Value = TextBox5.Text .Offset(1, 8).Value = TextBox6.Text End With End With TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" TextBox6.Text = "" CheckBox1.Value = False CheckBox2.Value = False End Sub 以上です。 おかしなところ満載かと思いますが、 チェックを入れた項目だけ値を入れたいと考えております。 おわかりになるかたおりましたら何卒お助けください汗 よろしくお願いいたします。

  • 【ファイルサーチ】指定のフォルダーではなく自分で選択したフォルダー内のファイルの総数をカウントしたい

    お世話になります。指定のフォルダーではなく自分で選択したフォルダー内の"csvファイル"の総数をカウントしたいのですがうまくいきません。アドバイスお願いいたします。 With Application.FileSearch .LookIn = Application.GetOpenFilename .Filename = "*.csv" If .Execute > 0 Then MsgBox .FoundFiles.Count & "個" End If For i = 1 To .FoundFiles.Count MsgBox .FoundFiles(i) Next i End With

  • Excel VBAでIF~Thenの入れ子がうまくできません。

    いつもお世話になってます。 IF~Then~EndIfにIFを入れていますがうまくいきません。よろしくお願いします。 Private Sub CommandButton10_Click() Dim i As Long Dim 最終行 As String Dim サーチ行 As Long Dim 行 As Long Dim 列 As Long If TextBox33.Value = "" Then MsgBox "使用量を入力してください。" Else If TextBox11 <> "" Then TextBox26 = TextBox33 * TextBox11 / 100 '成分1 End If If TextBox12 <> "" Then TextBox25 = TextBox33 * TextBox12 / 100 '成分2 End If Workbooks.Open Filename:=ThisWorkbook.Path & "\データ物質試薬管理.xls" Sheets("shinki").Activate 最終行 = (Range("B2").End(xlDown).Row) '商品名の行検索 サーチ行 = 0 For i = 2 To 最終行 If ComboBox3.Value = Range("B" & i) Then Workbooks("データ物質試薬管理.xls").Close savechanges:=False '保存しない Workbooks.Open Filename:=ThisWorkbook.Path & "\データ物質試薬管理.xls" Sheets("kongou").Select Range("A65536").End(xlUp).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column Cells(行, 列) = UserForm11.TextBox16.Value 'CAS Cells(行, 列 + 1) = UserForm11.TextBox21.Value '使用日 Cells(行, 列 + 2) = UserForm11.TextBox29.Value '使用者 Cells(行, 列 + 4) = UserForm11.TextBox26.Value '成分1使用量 Cells(行 + 2, 列) = UserForm11.TextBox18.Value 'CAS Cells(行 + 2, 列 + 1) = UserForm11.TextBox21.Value '使用日 Cells(行 + 2, 列 + 2) = UserForm11.TextBox29.Value '使用者 Cells(行 + 2, 列 + 4) = UserForm11.TextBox24.Value '成分3使用量 Cells(行 + 2, 列 + 5) = UserForm11.TextBox32.Value '種類 Cells(行 + 2, 列 + 6) = UserForm11.TextBox34.Value '単位 Cells(行 + 2, 列 + 7) = UserForm11.ComboBox3.Value '商品名 Workbooks("データ物質試薬管理.xls").Close savechanges:=True 'showhinに在庫管理する Workbooks.Open Filename:=ThisWorkbook.Path & "\データ物質試薬管理.xls" Sheets("showhin").Select Range("A65536").End(xlUp).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column Cells(行, 列) = UserForm11.TextBox2.Value '品名コード Cells(行, 列 + 1) = UserForm11.ComboBox3.Value '商品名 'Cells(行, 列 + 2) = UserForm9.TextBox3.Value '1本の量 'Cells(行, 列 + 3) = UserForm9.TextBox4.Value '本数 Cells(行, 列 + 4) = UserForm11.TextBox34.Value '単位 Cells(行, 列 + 5) = UserForm11.TextBox32.Value '種別 Cells(行, 列 + 6) = UserForm11.TextBox21.Value '使用日 Cells(行, 列 + 7) = UserForm11.TextBox29.Value '使用者名 Cells(行, 列 + 9) = UserForm11.TextBox33.Value '使用量 Workbooks("データ物質試薬管理.xls").Close savechanges:=True MsgBox "登録しました。" End If サーチ行 = i Exit For 'End If Next If サーチ行 = 0 Then MsgBox ComboBox3.Value & "商品は登録されておりません。" & Chr(10) & "「新規商品登録」ボタンから入力してください。" End If End If If TextBox21.Value = "" Then '使用量 MsgBox "使用日を入力してください。" End If ComboBox3.SetFocus End Sub

  • エクセルVBA 呼出し

    エクセルVBA 呼出し FormをひらいてTextBox31に数字(ID番号)が入り それをSheet”計”のF4に入れます! そのF4を他のブックの WSName = "DATA.xls"にて IDを検索して、名前や色々なものをSheet”計”に写します。 それを再度、FromのそれぞれのTextBoxに入れます。 しかし、SH1.Cells(lngNumber, 2) = Worksheets("計").Range("B2").Value '名前 が上手くできません!!エラー表示などはないのですが… DATA.xlsにはID番号があるのですが、それを入力しても値が入りません どこの部分が間違っているのか? すいません、教えてください WSName = "DATA.xls"を呼出す記述は省略!! 'DATA.xlsとSheet1をセットする。 Set WS = Workbooks(WSName) Set SH1 = WS.Worksheets("Sheet1") 'ブックが存在していないのであればメッセージを出し処理を抜ける。 Else MsgBox WDName & "が存在していません。設置してください。", vbExclamation, "確認してください" Exit Sub End If flag = False For lng = 1 To lngYcnt_K '計のF4と同じ値を見つけてテキストボックスの値を入力。 If CStr(Worksheets("計").Range("F4").Value) = CStr(SH1.Cells(lng, 1)) Then flag = True lngNumber = lng Exit For End If Next lng If flag = True Then SH1.Cells(lngNumber, 2) = Worksheets("計").Range("B2").Value '名前 With Worksheets("計") ’計のSheetの値を開いているFromのTextBox4に再度値を入れる TextBox4.Value = .Range("B2").Value '計のSheetからTextBox1の値の名前’ End With MsgBox " 記録を呼び戻しました" Else TextBox31.Value = "確認必要" End If

  • Excel2003のVBAでエクセルファイルとして保存

    こんにちわ。 Excel2003のVBAで、シート1に採点用のフォーマットを作成し、採点ボタンを押したら別の場所(フォルダ)に別のファイル(.xls形式)として採点結果を保存したいと考えています。過去に似たような質問があったのでそれを参考にしたのですが、コードの意味がほとんど分かりません。下記のコードで実行したところ、エラーが出てしまいます。どこが悪いのか教えていただけないでしょうか? エラー箇所は BkName = OldWkbook.Sheets(StName1).Range("K1").Value です。”インデックスが有効範囲にありません”と表示されます。 例)   Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "ko" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("K1").Value FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1)).Copy Set NewWkbook = ActiveWorkbook 'シートの保護を解除 Worksheets("sheet1").Unprotect For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete '←1ではなくwIxです End If Next NewWkbook.Sheets(1).Name = StName1 ' FileName = "D:\保存\計画\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub

  • VBA 空白をエラー表示させる!

    ボタンをクリックすると、入力ミスがないように MsgBoxで表示させるものを作りましたが TextBox3を都合のため切り取りました! そしたら、エラー表示され If Controls("TextBox" & i).Text = "" Then ↑黄色く表示されます! どのように下の記述を変えれば良いか教えてください! Private Sub CommandButton5_Click() Dim i As Integer For i = 1 To 9 If Controls("TextBox" & i).Text = "" Then MsgBox "判定入力していない項目がありますよ!", vbInformation, "空欄を見て!" Exit Sub End If Next If MsgBox("記録するよ?", vbOKCancel) = vbOK Then With Worksheets("グラフ") 'アセスメント身体 .Range("U2").Value = TextBox1.Value .Range("U3").Value = TextBox2.Value .Range("U4").Value = TextBox3.Value .Range("U5").Value = TextBox4.Value .Range("U6").Value = TextBox5.Value .Range("U7").Value = TextBox6.Value .Range("U8").Value = TextBox7.Value .Range("U9").Value = TextBox8.Value .Range("U10").Value = TextBox9.Value

  • このVBA、もうちょっとシンプルにできないですか?

    自力でVBAを書いてみたのですが、長くなってしまいました。 もうちょっとシンプルにするアイディアがあればお願いします。 やりたいことは、 (1)ユーザーフォームのテキストボックス内が空欄だったら「無視」 (2)テキストボックスの中が空欄でなければ「書き込み」 以上のことをやりたいのですが、テキストボックスが6種類あるので単純に記述すると結構長くなってしまいました。 特に問題がなければ、その旨をお願いします。 If TextBox1 = "" Then If TextBox2 = "" Then If TextBox3 = "" Then If TextBox4 = "" Then If TextBox5 = "" Then If TextBox6 = "" Then MsgBox ("得点が入力されていません。") ElseIf TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If ElseIf TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value ElseIf TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If End If ElseIf TextBox4 <> "" Then Sheets("総合(得点)").Cells(t + 7, u) = TextBox4.Value If TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value If TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If End If End If ElseIf TextBox3 <> "" Then Sheets("総合(得点)").Cells(t + 6, u) = TextBox3.Value If TextBox4 <> "" Then Sheets("総合(得点)").Cells(t + 7, u) = TextBox4.Value If TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value If TextBox6 <> "" Then Sheets("総合(得点)").Cells(t + 9, u) = TextBox6.Value End If End If End If End If ElseIf TextBox2 <> "" Then Sheets("総合(得点)").Cells(t + 5, u) = TextBox2.Value If TextBox3 <> "" Then Sheets("総合(得点)").Cells(t + 6, u) = TextBox3.Value If TextBox4 <> "" Then Sheets("総合(得点)").Cells(t + 7, u) = TextBox4.Value If TextBox5 <> "" Then Sheets("総合(得点)").Cells(t + 8, u) = TextBox5.Value ・ ・ ・ こんな感じで規則的に記述しただけです。(文字数が多いので最後は省略しました) 段差がなくて見づらいですが、宜しくお願いします。

  • エクセル VBA OptionButtonからTextBox

    すいません! OptionButtonなら 下記の記述でエラー表示を 簡単にできるのですが これがOptionButtonではなく TextBoxならどのように変化したら 良いのでしょうか? すいません、教えて下さい! Private Sub 記録_Click() Dim i As Integer Dim Cnt As Integer Cnt = 0 For i = 1 To 6 Step 1 If Me.Controls("OptionButton" & i).Value Then Cnt = i Exit For End If Next i If Cnt = 0 Then MsgBox "選択されていません" Exit Sub End If If Me.Controls("Combobox" & Cnt).Value = "" Then MsgBox Me.Controls("OptionButton" & Cnt).Caption & " の内容が選択されていません" Exit Sub End If With 記入フォーム .TextBox5.Value = Me.Controls("OptionButton" & Cnt).Caption .TextBox6.Value = Me.Controls("Combobox" & Cnt).Value End With Unload Me End Sub

  • マクロにおける条件文の作成の件

    以下の様に条件付きの計算式を作成しました。CommandButton3を押しても 計算しなかったり、TextBox3.Value > TextBox1 ではないときでもエラー メッセージが出ます。どこに欠点があるのか教えて下さい。 Private Sub CommandButton3_Click() Dim row As Integer If TextBox1.Value = Empty Then MsgBox ("Aが空欄です") Exit Sub End If If TextBox2.Value = Empty Then MsgBox ("Bが空欄です") Exit Sub End If If TextBox3.Value = Empty Then MsgBox ("Cが空欄です") Exit Sub End If If TextBox4.Value = Empty Then MsgBox ("Dが空欄です") Exit Sub End If If TextBox3.Value > TextBox1.Value Then MsgBox ("Cの値をAの値より小さくしましょう!") Exit Sub End If If TextBox4.Value > TextBox2.Value Then MsgBox ("Dの値をBの値より小さくしましょう!") Exit Sub End If TextBox5 = Round(TextBox1 * TextBox2 - (TextBox1 - TextBox3) * (TextBox2 - TextBox4) / 2, 0) End Sub

専門家に質問してみよう