[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『長いパス名＋ファイル名のフォルダー間移動について』（パオ〜〜ン）
またまた、お知恵をお貸し下さい。
通常は、Name A-FL as B-FL でネットワーク配下のフォルダー間の移動できるファイルがあります。しかし中に、ファイルの名前がやたら長いものがあり、パス＋ファイル名の長さが256バイトを超えてしまって、移動不可能になるときがあります。
現状では、送り元のパス名より送り先のパス名のほうが長いので、送り先パス名＋ファイル名が256バイトを超えるときに、以下のような方法で送ろうとしました。（Sub LongNameFile_Move）
（１）送り元のファイル名を短いものに変更する。
（２）そのファイル名を使用して、送り元から送り先へ移動する。
（ここまでは、FileCopyにしろ、Name as にしろ、上手く動きます）
（３）送った先のファイル名を元のファイル名にRenameする。
この（３）のときに、ファイルが見つかりません、という実行時エラー'53'でマクロが停止します。
RepNm = Application.GetOpenFilename("PDFファイル,*.pdf") で移動させたファイル名を取得しても、
同様にマクロがエラー53で停止します。
別の単純にRenameするだけのマクロを作り、移動後のファイル名を変更するようにすると、エクセルをファイル移動からずっと立ち上げっぱなしで継続して行うと同様に実行時エラーがでます。が、一旦エクセルを止めて再起動して、同じRenameのみのマクロを走らせると上手くRenameできます。
どのようにすれば、上手くファイルを移送して、元の長いファイル名に置き換えできるでしょう？
以下に使用したマクロを掲載します。
Sub PDFファイル移送()
Dim FDir As String 'From 個人用フォルダー
Dim TDir As String 'To ソフトウェア依頼書格納フォルダー
Dim FFNm As String '個人用フォルダー Path＋FileName
Dim FBkNm As String 'ソフトウェア依頼書 Book Name
Dim FBkFol As String
Dim TFNm As String '個人用フォルダー Path＋FileName
Dim TBkNm As String 'ソフトウェア依頼書 Book Name
Dim TBkFol As String
Dim ManNo As String
Dim Yy As Integer '西暦年
Dim Gyy As Integer '和暦年
Dim mm As Integer
Dim ps As Integer '\位置確認
Dim wStrS As Variant, wByteS As Variant
Dim sh As Worksheet
Set sh = ActiveSheet
Gyy = Year(Date) - 1988
mm = Month(mm)
If Day(Date) > 15 Then
mm = mm + 1
If mm > 12 Then
mm = 1
Gyy = Gyy + 1
End If
End If
ManNo = "aaaaa"
FDir = "\\ffffff\999999_個人用データ\" & ManNo
With CreateObject("WScript.Shell")
.currentdirectory = FDir
End With
MsgBox "ファイルを所定のフォルダーへ移動します。ファイルを指定して下さい。", vbOKOnly
FFNm = Application.GetOpenFilename("PDFファイル,*.pdf")
wStrS = StrConv(FFNm, vbFromUnicode)
If LenB(wStrS) > 256 Then
MsgBox "送り元のファイル名が長すぎます。" & LenB(wStrS) & "バイトあります。256バイトに収めるか、直接、格納して下さい", vbOKOnly
Exit Sub
End If
ps = InStrRev(FFNm, "\")
FBkNm = Right(FFNm, Len(FFNm) - ps)
FBkFol = Left(FFNm, Len(FFNm) - Len(FBkNm))
TDir = "\\ffffff\nnnnnn_○○システム○○○○○\mmm_□□□\lll_△△△△\kkk_○○○○○○○○\aaa_◎◎◎◎◎\○○△△△△△△G○○○○○○○○○○○○○○\"
With CreateObject("WScript.Shell")
.currentdirectory = TDir
End With
MsgBox "格納先フォルダーを指定して下さい。", vbOKOnly
TFNm = Application.GetOpenFilename(",*.*")
ps = InStrRev(TFNm, "\")
TBkNm = Right(TFNm, Len(TFNm) - ps)
TBkFol = Left(TFNm, Len(TFNm) - Len(TBkNm))
With CreateObject("WScript.Shell")
.currentdirectory = TDir
End With
wStrS = StrConv(TDir & FBkNm, vbFromUnicode)
wByteS = LenB(wStrS)
If wByteS > 256 Then
Call LongNameFile_Move(TDir, TBkFol, FDir, FBkFol, FBkNm)
End If
Name FFNm As TBkFol & FBkNm
End Sub
Sub LongNameFile_Move(TDir, TBkFol, FDir, FBkFol, FBkNm)
Dim RepOutNm As String, RepNm As String
Dim RepBkNm As String, RepFolNm As String
Dim ps As Integer
RepOutNm = FBkNm
RepNm = Left(FBkNm, 9) & "A " & Right(FBkNm, 4)
With CreateObject("WScript.Shell")
.currentdirectory = FDir
End With
Name FBkNm As RepNm
With CreateObject("WScript.Shell")
.currentdirectory = TBkFol
End With
FileCopy FDir & "\" & RepNm, TBkFol & RepNm
With CreateObject("WScript.Shell")
.currentdirectory = TBkFol
End With
MsgBox "移動させたファイルを選択して下さい"
RepNm = Application.GetOpenFilename("PDFファイル,*.pdf")
ps = InStrRev(RepNm, "\")
RepBkNm = Right(RepNm, Len(RepNm) - ps)
RepFolNm = Left(RepNm, Len(RepNm) - Len(FBkNm))
With CreateObject("WScript.Shell")
.currentdirectory = TBkFol
End With
Name RepBkNm As FBkNm
End Sub
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
ファイル名を短くしてコピーしているのは、元のファイル名のままだと長すぎてコピーできないから、一時的に短くして、コピー後にリネームすればよいだろう、と考えたためであり、実際はリネームで同様にエラーになってしまい、駄目だったというだけで、ファイル名を変える事は本来は不要な処理だ、という解釈で正しいでしょうか？
案1。コマンドプロンプトでSUBSTコマンドを使い、フォルダの深い位置をドライブ名に置き換えてしまう。 本来のフルパスへの変換はOS内で行われるので、アプリからは短いフルパスとしてコーディングできます。
案2。コマンドプロンプトのCOPYコマンドを使ってコピーする。 Excelから実現するには、バッチファイル化するか、Wscript.ShellオブジェクトでRunするか、でしょうか。
いずれにせよ、コマンドプロンプト上で1つコピーするバッチファイルを作成し実行してみれば、可能かどうか確認できるでしょう。
（???） 2017/12/20(水) 16:50
早速のご教示、ありがとうございます。
＞要はフルパスにすると256バイトを超える場所にファイルコピーできれば良いのですね？
その通りです。(^^;;
＞ファイル名を変える事は本来は不要な処理だ、という解釈で正しいでしょうか？
問題なのは、ファイルの名前の長さがファイルによってマチマチで、普通の長さ（６０バイト程度）なら何問題なく処理できるのですが、中にこれでもか、と思うほど長いファイル名が存在するのです。
移動にパス名＋ファイル名の制限がなければ、こういう対処は全く不要です。
フォルダの階層の方をドライブ名で置き換えて行う方法は、ネットで調べてわかって履いたのですが、ファイル名の方が長くなることを考えると、そこをリネームして行く方法の方が良いかと考えた次第です。
済みません。ごちゃごちゃと書いて、かえって分かり辛い文章にしていしまいました。
（パオ〜〜ン） 2017/12/20(水) 17:21
とりあえず、指定フォルダ以下全てのPDFをコピーする例なぞ。サーバ環境を合わせるのは面倒なので、これで長いフルパス問題が解決するかまでは確認していません。 また、選択したファイルだけにしたいならば、そこはご自由に変えてください。 更に、WINDOWS7で動かしたので、WINDOWS10だとコマンドのオプションが変わっている可能性があります。
Sub test()
Const TDir = "\\ffffff\nnnnnn_○○システム○○○○○\mmm_□□□\lll_△△△△\kkk_○○○○○○○○\aaa_◎◎◎◎◎\○○△△△△△△G○○○○○○○○○○○○○○"
Dim ManNo As String
Dim FDir As String
Dim vw As Variant
ManNo = "aaaaa"
FDir = "\\ffffff\999999_個人用データ\" & ManNo
With CreateObject("WScript.Shell")
vw = .exec("net use x: """ & TDir & "").StdOut().ReadAll()
vw = .exec("cmd /c copy /y """ & FDir & "\*.pdf"" """ & TDir & """").StdOut().ReadAll()
vw = .exec("net use x: /delete /yes").StdOut().ReadAll()
End With
End Sub
（???） 2017/12/20(水) 18:32
重ねてのご教示、有難うございます。
早速トライしてみます。
（パオ〜〜ン） 2017/12/21(木) 09:14
ありがとうございます。
お陰を持ちまして、解決しました。
（パオ〜〜ン） 2017/12/21(木) 13:24
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.