エクセルでマクロ。他のパソコンではエラーになる。

セル値からフォルダー名を取得して、ある場所にフォルダーを作成するというものです。
下記を私のPCでは問題なく動作するのですが、
別のPCからは「パスが見つかりません」とエラーになります。
デバッグは「MkDir mydir」を指しています。
すべてのPCから実行可能にするためにはどの様にすればよろしいのでしょうか？
ご教授願います。
win10、excel2013

Sub フォルダー作成()

Dim mydir As String
Dim i As Integer

For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
mydir = "C:\Users\user\Desktop\test\" & Cells(i, 17).Value
If Dir(mydir, vbDirectory) = vbNullString Then MkDir mydir
Next i
MsgBox "完了しました"

End Sub

質問者からの補足コメント

• 実際のプログラムは下記です。
  宜しくお願い致します。
  
  Sub フォルダー作成()
  Dim mydir As String
  Dim i As Integer
  For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
  mydir = "C:/Google ドライブ/T/01_T/02_受注/" & Cells(i, 17).Value
  If Dir(mydir, vbDirectory) = vbNullString Then MkDir mydir
  Next i
  MsgBox "完了しました"
  End Sub

    補足日時：2017/07/06 13:28

No.5 ベストアンサー 回答者： TH69 回答日時： 2017/07/06 13:13

ファイルやフォルダを扱うなら、FileSystemObjectが便利と思います。

作成したいフォルダのパスをmydirとして、それが存在しなければ作成します。
これでもだめでしょうか？

Sub test()
Dim mydir As String, i As Long
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
mydir = "C:/Google ドライブ/T/01_T/02_受注/" & Cells(i, 17).Value
If FSO.FolderExists(mydir) = False Then
FSO.CreateFolder mydir
End If
Next i
MsgBox "完了しました"
Set FSO = Nothing
End Sub

この回答へのお礼

ご回答、ありがとうございます。

試しましたところ
パスがみつかりません
となり
デバックは
FSO.CreateFolder mydir
を指していました。

お忙しい中、申し訳ないです。

お礼日時：2017/07/06 13:21

No.6 回答者： TH69 回答日時： 2017/07/06 15:13

実際に私のPCで同じフォルダ構成でやってみましたが、フォルダ作成は問題なしでした。

fumi23_o様のPCだけということなので、フォルダ名か何か、パスが間違っていないでしょうか？

この回答へのお礼

TH69様、ありがとうございます。
仰る通り、パスを間違えておりました。
問題解決しました。
お忙しい中、本当にありがとうございました。

お礼日時：2017/07/06 15:27

No.4 回答者： WindFaller 回答日時： 2017/07/05 20:30

こんばんは。

>すべてのPCから実行可能にするためにはどの様にすればよろしいのでしょうか？
こんなふうにしてみたらいかがでしょうか？
Shell(command prompt)からも取る方法はあったはずですが、
CreateObject("Wscript.Shell").SpecialFolders
この方法がメジャーだと思います。

'//
Sub フォルダー作成R()
Dim myDir As String
Dim i As Integer
myDir = CreateObject("Wscript.Shell").SpecialFolders(4) & "\Test"
If Dir(myDir, vbDirectory) = "" Then
MsgBox "Testフォルダーがありません。", vbCritical
Exit Sub
End If
For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
myDir = myDir & "\" & Cells(i, 17).Value
If Dir(myDir, vbDirectory) = "" Then
　MkDir myDir
End If
Next i
MsgBox "完了しました"
End Sub

この回答へのお礼

ご回答、ありがとうございます。
当方マクロ初心者でして、
このプログラムもたまたまネット上で見つけてフォルダー位置を変更して利用しております。
実際のフォルダー位置でのプログラムは下記です。
申し訳ないですがもう少しお願いいたします。


Sub フォルダー作成()

Dim mydir As String
Dim i As Integer

For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
mydir = "C:/Google ドライブ/T/01_T/02_受注/" & Cells(i, 17).Value
If Dir(mydir, vbDirectory) = vbNullString Then MkDir mydir
Next i
MsgBox "完了しました"

End Sub

お礼日時：2017/07/06 11:52

No.3 回答者： TH69 回答日時： 2017/07/05 19:58

デスクトップだと、それぞれのPCのユーザー名はどうなるのかな？

ユーザー名に左右されないCドライブ直下などにフォルダを作って試してみては…？

外してたらごめんなさい。

この回答へのお礼

ご回答、ありがとうございます。

例えが悪かったですね。
実際はどのPCもCドライブ直下なんです。

お礼日時：2017/07/06 11:46

No.2 回答者： neKo_deux 回答日時： 2017/07/05 17:46

> 何故なんでしょうか？！

エラーの原因を探ってみては。

Sub フォルダー作成()

Dim mydir As String
　　Dim i As Integer

　　On Error Goto myErr
　　For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
　　mydir = "C:\Users\user\Desktop\test\" & Cells(i, 17).Value
　　If Dir(mydir, vbDirectory) = vbNullString Then MkDir mydir
　　Next i
　　MsgBox "完了しました"
　　Exit Sub

myErr:
　　MsgBox "エラー番号:" & Err.Number & vbCrLf & _
　　　　　　"エラーの種類:" & Err.Description, vbExclamation

End Sub

で、エラーが発生すると、エラーの番号、エラーの種類が取得できるハズなので、

MkDir 関数
https://msdn.microsoft.com/ja-jp/library/k1d22wf …

エラー番号が70ならアクセス権が無いとか。
エラー番号が75ならディレクトリが既に存在してるって事で、Ifの条件判断を確認とか。

この回答へのお礼

ご回答ありがとうございます。

これを実行すると
エラー番号：76
エラーの種類：エラーパスがみつかりません
と表示されます。

一体なにが原因なんでしょうか。。。

お礼日時：2017/07/06 11:44

No.1 回答者： neKo_deux 回答日時： 2017/07/05 17:00

MkDirは階層のあるフォルダを一気に作成できません。

> 別のPCからは「パスが見つかりません」とエラーになります。

"C:\Users\user\Desktop\test\"
のフォルダを予め作っといてください。


あるいは、下記のサイトのような方法で逐次フォルダを作るとか。

MkDirで階層の深いフォルダーを作成する:エクセルマクロ・Excel VBAの使い方-VBA関数
http://www.relief.jp/docs/excel-vba-mkdir-folder …

この回答へのお礼

お答え、ありがとうございます。

> "C:\Users\user\Desktop\test\"
のフォルダを予め作っといてください。

もちろん別のPCにも同じ場所に同じフォルダがあるんですよ。

なのに、私のPCでしか動作しないのは何故なんでしょうか？！

お礼日時：2017/07/05 17:22