フォルダ内にあるファイル(xlsx)を1つのファイルごとに分類したいため、
そのファイル名と同名のフォルダを元のフォルダ内に新たに作成し、そこに保存したいという
下記のマクロを見つけて動かしてみたのですが、

FileCopy FPath & "\" & TargetFile, FPath & "\" & DName  & "\" & TargetFile
の箇所でファイルが存在しないと出ました。

色々と調べた結果、サーバーの中にあるファイルを作ろうとしているのですが
サーバーの階層が深く取得するパス名が300文字になっていたので
Dir関数だとエラーになることが判明し、対策として
ショートパスへ変換する方法やFSOを使って行えば解決するという所までは
調べたのですが、上手くいきません。

分かる方がいればアドバイスを頂ければと思い質問をさせて頂きました。
宜しくお願い致します。




Sub フォルダ作成()
  Dim FPath, TargetFile, DName

  FPath = Range("A1").Value
'セルのA1にサーバーのパスを記載しています

\\TEST\TESTファイル\管理項目\管理簿\各担当部署\確認事項\
上記の記載は例ですが本来の記載はかなり長く、260文字くらいあります。

  If FPath = "" Then Exit Sub
  TargetFile = Dir$(FPath & "\*.xlsx")
  Do While TargetFile <> ""
   DName = Left(TargetFile, InStrRev(TargetFile, ".") - 1)

   MkDir FPath & "\" & DName
ファイル名と同名のフォルダをサーバーに作成するのは成功しています。

   FileCopy FPath & "\" & TargetFile, FPath & "\" & DName _
      & "\" & TargetFile
上記の部分でエラーが出ており、パス名が長いためエラーになっています。


   Kill FPath & "\" & TargetFile
   TargetFile = Dir$
  Loop

 End Sub


Dim fso As New FileSystemObject
ファイルオブジェクトを使い、ショートパスにすればという
所までは調べたのですが、そこからどう繋げていいか不明なので
お手数ですがご教授願えないでしょうか?

A 回答 (1件)

このご質問の回答としては、私は、以下のコードを提示しますが、何か別の方法があったような気がしてなりません。



Function shortName(ByVal FileName As String)
'ショートネイム用のユーザー定義関数
 Dim objFS As Object
 Dim objFile As Object
 Set objFS = CreateObject("Scripting.FileSystemObject")
 If Right(FileName, 1) <> "\" Then 'フォルダーとファイルの区分け
  Set objFile = objFS.GetFile(FileName)
 Else
  Set objFile = objFS.GetFolder(FileName)
 End If
 shortName = objFile.shortPath
End Function

使用例:
Sub TestLongFileName()
 Dim fn As String

 Dim dst As String
 fn = "---long Name file ----"
 fn = shortName(fn)
 If Dir(fn) = "" Then
  MsgBox "ファイルが見つかりません", vbCritical
  Exit Sub
 End If

 dst = ""---long Name Path ----"" '末尾に¥を入れないとエラーが出ます。
 dst = shortName(dst)
FileCopy fn, dst
' ' Shell ("cmd.exe /c Copy " & fn & " " & dst)
End Sub
    • good
    • 0
この回答へのお礼

返答ありがとうございます。
元のマクロと組み込んでショートネイム用のユーザー定義関数を使い
ファイルのパスを取得することは出来ました。

細かい所の調整は行って色々と試したいと思います。
アドバイスありがとうございました。

お礼日時:2017/05/17 19:19

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報