• ベストアンサー
  • すぐに回答を!

VBAで、作成したファイルの共有サーバーへの保存

エクセルVBAでわからないことがあります。 社内でLANで結ばれた端末が何十台かあります。 各端末で作業したデータを共有サーバー内のフォルダーにテキストとして保存させようと思います。 サーバーのパスは仮に "\\FXHOGEHOGE\S999\DATA_Auto" とします。 マクロを書いたエクセルのBOOKは、各端末内に保存されてます。 jコードは概略以下のとおりです。 Sub test01() With Worksheets(Sheets.Count) MsgBox Right(.Range("A2").Value, 8) & "の保存開始。", vbInformation" .Name = "Data" & Right(.Range("A2").Value, 8) .Copy End With ChDrive "F" ChDir "F:\DATA_Auto" Application.Dialogs(xlDialogSaveAs).Show ARG1:="DNR.txt", ARG2:=3 ActiveWindow.Close (False) End Sub これでたいていは大丈夫なのですが、なかには共有サーバーのドライブをFではなく、GとかEとかに設定しているひとがいて、失敗します。   ChDrive "F"   ChDir "F:\DATA_Auto" のFを、それぞれの方に合わせて書き換えるか、あるいは社内でFに統一すればすむことですが、どちらも厄介です。 "\\FXHOGEHOGE\S999\DATA_Auto" というパスは変わらないので、これから、各端末で設定したドライブ名を取得するか、あるいは、Application.Dialogsで自動的にこのドライブとディレクトリを指定ことはできないものでしょうか?

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数2617
  • ありがとう数3

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

  • ベストアンサー
  • 回答No.1
  • keithin
  • ベストアンサー率66% (5278/7939)

安直と言えば安直ですが 変更前: Application.Dialogs(xlDialogSaveAs).Show ARG1:="DNR.txt", ARG2:=3 変更後: Application.Dialogs(xlDialogSaveAs).Show ARG1:="\\FXHOGEHOGE\S999\DATA_Auto\DNR.txt", ARG2:=3 などで。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

なるほど! ARG1:="\\FXHOGEHOGE\S999\DATA_Auto\DNR.txt" でいいんですね、ありがとうございます。 ドライブが変わる場合はかならずChDriveをしなければいけないと思い込んでいました。 それで実務上はこれでOKなんですが、やはり "\\FXHOGEHOGE\S999\DATA_Auto から、端末で設定したFとかGとかのドライブ名は取得できないということなんでしょうか?

関連するQ&A

  • フォルダ作成と別名保存【VBA】

    教えてください 現在、下の2つのマクロを使っています。 「O27」の値でフォルダを作るものとブックを別名保存するものです。 これを1つにまとめたいのですが単純に1つにまとめるとフォルダは作成されるのですがブックの別名保存がセルの値を参照してくれません。 また、MkDir でフォルダを作成すると同じ名前のフォルダが先にあるとエラーになってしまいます。 この2点を解消できる方法はないでしょうか? よろしくお願いいたします。 Sub 別名フォルダ() MkDir Worksheets("オーダーシート").Range("O27").Value End Sub Sub 別名保存() Application.Dialogs(xlDialogSaveAs).Show Arg1:=Range("O27").Value End Sub

  • VBAの組み込みダイアログの引数Argについて

    エクセルVBAでの質問です。 エクセルとして名前をつけて保存なら Sub aaa() Application.Dialogs(xlDialogSaveAs).Show ARG1:="ABC.xls", ARG2:=1 End Sub テキストファイルとして名前をつけて保存なら Sub bbb() Application.Dialogs(xlDialogSaveAs).Show ARG1:="ABC.txt", ARG2:=3 End Sub CSVファイルとして名前をつけて保存なら Sub ccc() Application.Dialogs(xlDialogSaveAs).Show ARG1:="ABC.csv", ARG2:=6 End Sub でうまくいきます。 今度は、ファイルを開こうとxlDialogOpenに変えました。 Sub aaa2() Application.Dialogs(xlDialogOpen).Show ARG1:="ABC.xls" ', ARG2:=1 End Sub Sub bbb2() Application.Dialogs(xlDialogOpen).Show ARG1:="ABC.txt", ARG2:=3 End Sub 以上二つはファイル名入りのダイアログは出ました。でもダイアログの画面にはフォルダーしか表示されません。 Sub ccc2() Application.Dialogs(xlDialogOpen).Show ARG1:="ABC.csv", ARG2:=6 End Sub これは実行時エラーになりました。 どうも、Application.Dialogs(xlDialogSaveAs)とApplication.Dialogs(xlDialogOpen)では引数ARG2が違うようです。 Application.Dialogs(xlDialogOpen)でのARG2は何の指定なのでしょうか?またその数値の意味はなんでしょうか?

  • サーバーに保存したエクセルファイルでChDrive、ChDirがエラーになる

    ひとつのフォルダにエクセルブックを6個置います、日常のデータ入力をする、メインのブックに 他ブックをオープンするコードを、以下のように書いています。 Sub 他ブックオープン1() Application.ScreenUpdating = False ChDrive ThisWorkbook.Path ChDir ThisWorkbook.Path ブック名 = "○○.xls" For Each myBook In Workbooks If myBook.Name = ブック名 Then Workbooks("○○.xls").Activate Exit Sub End If Next Workbooks.Open ("○○.xls") Application.ScreenUpdating = True End Sub この、フォルダをサーバーに置いて、クライアントのパソコンから 上記コードを実行すると、実行時エラー "プロシージャの呼び出し、または引数が不正ですとなり、うまく 行きません、デバッグ画面でChDrive,ChDir に示される、アドレスを みると、正しく\\○○サーバー\...と表示されます、どうしてこの アドレスを認識しているのに、エラーが出るのかわかりません どなたか宜しくご教示願います。

その他の回答 (1)

  • 回答No.2
  • keithin
  • ベストアンサー率66% (5278/7939)

無理にこだわる事もないと思いますが。。。ベタですけど例えばこんなカンジですかね。 Sub macro1()  Dim o, e, i  Dim res as string  On Error Resume Next  Set o = CreateObject("WScript.Network")  Set e = o.EnumNetworkDrives  For i = 0 To e.Length - 1 Step 2   'とりあえずイミディエイトウィンドウで確認。   Debug.Print e(i), e(i + 1)   If e(i + 1) = "\\FXHOGEHOGE\S999\DATA_Auto" Then    res = e(i)    Exit For   End If  Next i  If res = "" Then res = "Not Mapped"  MsgBox "対象ドライブ名: " & res  Set o = Nothing End Sub WinAPIを使う方法とかも,探すと幾つかヒットすると思います。 やって出来ないということは,そんなに無いと思いますよ。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございます。 けっこうむずかしいんですね。 お手間とらせました。

関連するQ&A

  • エクセルVBAでPDF保存ができません

    エクセルのシートを連続してPDFで出力するVBAで困っています。 自分の端末内で動かす分にはぜんぜん問題はありません。ところが会社のサーバー内の共有フォルダーに保存して動かすと、最初の1件だけは正常にPDFに保存されますが、何度やっても2件目でエラーになりPDFが保存されません。 「実行時エラー1004 ドキュメントを保存できませんでした。ドキュメントが開いているか、保存時にエラーが発生した可能性があります。」 となってしまうのです。 PDFが保存されないうちに次のPDFを作成して保存しているためかと思いApplication.Waitで10秒待つようにしたところ最後まで保存ができました。 しかし、自分の端末内ではWaitを入れなくとも問題なくできます。 質問は、この原因と、一律にApplication.Waitで10秒待たなくとも別の方法で対応する方法はないかということです。 よろしくお願いいたします。 Sub TEST01() '2020/10/10   Dim Fdr As String, Fn As String   Dim n As Long      With Sheets("Test")     .Activate     Fdr = ThisWorkbook.Path & "\" & Format(Date, "YYYYMMDD") & "-PDF" 'PDF保存先'     If Dir(Fdr, vbDirectory) = "" Then        MkDir Fdr '無ければ作成     End If          For n = 1 To 20       .Range("C5").Value = Sheets("Data").Cells(n, "A").Value       Fn = .Range("C5").Value & "_" & .Range("D5").Value  'ファイル名       Application.StatusBar = Fn & " PDFファイル作成中/" & n & "件目"       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fdr & "\" & Fn & ".pdf"       Application.Wait Now() + TimeValue("00:00:10")   '10秒PDF保存完了を待つ(1-8秒では保存エラー)     Next n   End With   Application.StatusBar = "" End Sub

  • エクセルの保存で。

    xls形式で保存したあとに、csv形式で保存するVBAを作りました。 csv形式で保存するときは指定したディレクトリ「c」を 表示してくれるのですが、 xls形式のときは実行時のカレントを指定しまいます。 なぜでしょう??? Sub filehozon() Dim MyFileA 'As String MyFileA = "c:\test" 'xls形式保存 Application.Dialogs(xlDialogSaveAs).Show arg1:=MyFileA, arg2:=1 Sheets(2).Copy Application.DisplayAlerts = False 'csv形式保存 Application.Dialogs(xlDialogSaveAs).Show arg1:=MyFileA, arg2:=6 ActiveWindow.Close Application.DisplayAlerts = True End Sub

  • ファイルの保存場所を設定してしまう方法

    ファイルを保存する時に、保存先を指定できるマクロ(下記参照)があります。 保存場所あらかじめ設定するには、何を足せばいいのでしょうか? Sub NameSave() Application.EnableEvents = False Application.Dialogs(xlDialogSaveAs).Show arg1:=ファイル名 Application.EnableEvents = True End Sub vbaは初心者です。 エクセル2003を使っています。 ご存知の方、どうぞ教えてください。 よろしくお願いいたします。

  • VBAのエラーについて

    いつも識者の皆様にはお世話になっております。 Excel VBAのことで質問させてください。 Range("i23").Value = Application.VLookup(ThisWorkbook.Worksheets("aaa").Range("b5"), ThisWorkbook.Worksheets("data").Range("a2:b7"), 2, 0) というコードは通るのですが、 Range("i23").Value = Application.Left(VLookup(ThisWorkbook.Worksheets("aaa").Range("b5"), ThisWorkbook.Worksheets("data").Range("a2:b7"), 2, 0), 2) というleft関数を追加したコードだと「sub または function が定義されていません」というエラーになってしまいます。 VBAを始めたばかりなのですが、何か根本的な勘違いをしていますでしょうか? ちなみに Range("i23").Value = Application.Left(Application.VLookup(ThisWorkbook.Worksheets("aaa").Range("b5"), ThisWorkbook.Worksheets("data").Range("a2:b7"), 2, 0), 2) というコードも通りませんでした。 ご回答よろしくお願いいたします。

  • Excel2007VBAを使ってPDF保存するには

    宜しくお願い致します。 あるサイトを参考に自分の設定を下記情報に設定しました。 保存の画面が出るのですが、【OK】しても実際にはデスクトップには保存されません。 ちゃんとデスクトップに保存をするにはどうしたら良いでしょうか? VBAの知識はなく、さっぱりわかりません。 どうぞご教授をお願い致します。 Sub SaveFileSample011() Dim SaveFileName Dim wScriptHost As Object, strInitDir As String 'カレントディレクトリをデスクトップに変更 a = Range("a2").Value b = Range("c9").Value Set wScriptHost = CreateObject("WScript.Shell") ChDir wScriptHost.SpecialFolders("Desktop") SaveFileName = Application.GetSaveAsFilename(a & "様" & b, "PDFとして保存,*.pdf") If SaveFileName <> False Then MsgBox "入力されたファイル名は、" & SaveFileName & " です。", vbInformation Else MsgBox "キャンセルがクリックされました。", vbInformation End If End Sub

  • VBAでエラー時にメッセージを表示したい

    こんばんわ! エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになりますがその際にDATAシートにデーターが入っていませんとメッセージボックスが出る様にするにはどうすればいいでしょうか? まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True End Sub

  • エクセルVBAで保存がうまくいきません

    エクセル2000です。 下記のようなVBAを記述しました。 「はい」なら別名保存 「いいえ」なら上書き保存のつもりです。 問題点 Sheets("AAA").Range("I9")の文字列内に.(半角ピリオド)があるとファイルに拡張子がつきません。 どうしたらよいのでしょうか?非常に困っています。 Sub 保存ボタン() Dim myYN As Integer Dim DRtn As Boolean Dim fn As String, fn2 As String fn = Sheets("AAA").Range("I9").Value & "_保存" fn2 = ThisWorkbook.Name myYN = MsgBox("現在の入力内容を別名で保存しますか?" _ + Chr(&HD) + Chr(&HA) + "別名保存なら「はい」" _ + Chr(&HD) + Chr(&HA) + "上書保存なら「いいえ」を選択します。" _ + Chr(&HD) + Chr(&HA) + "", vbYesNoCancel + vbQuestion, " 別名保存") If myYN = vbCancel Then Exit Sub 'キャンセルなら終了 If myYN = vbNo Then fn = fn2 '上書保存ならファイル名はそのまま DRtn = Application.Dialogs(xlDialogSaveAs).Show(ARG1:=fn, ARG2:=1) If DRtn = False Then Exit Sub 'ファイル名を消されたらキャンセル ThisWorkbook.Save '保存 ThisWorkbook.Close '閉じる End Sub

  • excelマクロを用いてのファイル作成について

    excelマクロを用い複数個のファイルを作成する作業を行いたいです。 ファイルの作成そのものは実行できているのですが、その内容に関して 変更したい個所があります。 その変更の仕方がわからないので教えて頂きたいです。 Dim i As Integer For i = 1 To 100 Workbooks.Add Range("a1").Value = "[data,text]=xlsread('DS_0frac.xls','ds0_" & i & "')" Range("a2").Value = "u=" Range("a3").Value = "n=data(u,2)" Range("a4").Value = "a=data(u+n+1,2);b=data(u+n+1,3);c=data(u+n+1,4)" Range("a5").Value = "x1=data(u+1,2);y1=data(u+1,3);z1=data(u+1,4)" Range("a6").Value = "tank=b/a" ChDir "C:\Documents and Settings\orner\My Documents\DS\m" ActiveWorkbook.SaveAs Filename:= _ "C:\Documents and Settings\orner\My Documents\DS\m\flds0_" & i & ".m", _ FileFormat:=xlText, CreateBackup:=False Windows("flds0_" & i & ".m").Close savechanges:=False Next i End Sub 上記のようなマクロを実行したところ得られるファイルの内容は以下のようになりました。 "[data,text]=xlsread('DS_0frac.xls','ds0_1')" u= "n=data(u,2)" "a=data(u+n+1,2);b=data(u+n+1,3);c=data(u+n+1,4)" "x1=data(u+1,2);y1=data(u+1,3);z1=data(u+1,4)" tank=b/a 実際には1,3,4,5行目の " を省いた形での出力を望んでいます。 マクロ本文中で " を取り除いた場合には 複数エラーが発生し実行できません。 解決法について教えて頂きたいです。 宜しくお願いします。

  • マクロです。教えてください。

    シートC5にある名前で保存する。 Windows("シート名.xlsm").Activate Application.Dialogs(xlDialogSaveAs).Show Arg1:=Range("C5").Value を実行すると正しく保存されますが、すぐ「名前を付けて保存」がもう一度開かれます。 どうしてでしょうか? 二度目はキャンセルを押して終了しますが、どうやったら二度目を表示させなくできますか? お教えください。

  • エクセルで「名前を付けて保存」を自動的に名前を付けて保存したい

    エクセルで「名前を付けて保存」をする時に自動的に名前を付けて保存が出来るように出来ないでしょうか。 エクセルで見積書を作成後に「名前を付けて保存」→「受注番号入力」をしているので、これを「名前を付けて保存」をクリックした時にファイル名を自動的に受注番号が入れば少しでも時間短縮が出来るかと思い、相談させていただきます。 自分なりに参考書などを読み、下記のようになると思ったのですが、出来ません。 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SavaAsUI Then Application.EnableEvents = False Application.Dialogs(xlDialogSaveAs).Show _ Arg1:=Me.Path & Application.PathSeparator & Sheet(1).Range("A1").Value Application.EnableEvents = True Cancel = True End If End Sub シート1に見積書があり、シート2、シート3はありません。 「A1」のセルに受注番号が入っています。 これのどこがダメなのか教えてもらえませんか。 もし、他に方法があるのであれば教えていただけませんか。 ご無理申します。