締切済み

エクセルのVBA ファイルの移動

  • 困ってます
  • 質問No.9603663
  • 閲覧数73
  • ありがとう数0
  • 気になる数0
  • 回答数2
  • コメント数0

お礼率 0% (0/2)

同一のフォルダーに保存されたファイルを
異なるフォルダーに保存するマクロを作成したいです

例えば
ファイル名 フォルダ名
あいう様 aaa → ア あいう様
あいう様 bbb → ア あいう様
いいい様 aaa → イ いいい様
かきく様 ddd → カ かきく様
さしす様 aaa → サ さしす様
たちつ様 ccc → タ たちつ様

保存先にフォルダ名がなければ作成して保存するマクロを
作りたい場合はどのようにすればいいでしょうか?

下記のURLを使い、ファイル名を変更したあと
上記の通りにフォルダー移動がしたいです
https://www.relief.jp/docs/017844.html

回答 (全2件)

  • 回答No.2

ベストアンサー率 28% (4476/15933)

他カテゴリのカテゴリマスター
VBAというよりも、VBSのFSOという、エクセルVBAを補完してくれるソフトをつかえばわかりやすいのでは。VBAに含まれているとしている向きもあるが。
ーー
例えば、Googleで、「vbs fso ファイル移動」で照会し、出てくる記事の、例えば
http://www.whitire.com/vbs/tips0087.html
「ファイルを移動する」
を使って、FROMとTOに当たる、ファイルのフルパスの文字列をプログラムで作成したら済むことではないか。
その時、現フォルダ(1つ?明記のこと)を、For Eachでループ処理してFROMに当たるファイルを、シートの該当テーブルを作っておいて、探して、見つければよい。
いっそのこと、シートにフルパスで移動前、移動後の対照表を手作業やプログラムなどで、作ってしまうのも、安心できるやり方だろう。
  • 回答No.1

ベストアンサー率 59% (195/327)

他カテゴリのカテゴリマスター
こうでしょうか。

Option Explicit

'Microsoft Scripting Runtime を参照設定

Sub Test1()
 
 Const GetDir = "D:\Test\FDir" '複写元フォルダー
 Const PutDir = "D:\Test\TDir" '複写先フォルダー
 Const KeyTex = "様"
 
 Dim FSO As New Scripting.FileSystemObject
 Dim fl As Folder
 Dim f As File
 Dim PutFName As String
 Dim wsDir As String
 Dim KeyPos As Long
 
 Set fl = FSO.GetFolder(GetDir)

 For Each f In fl.Files ' フォルダ内のファイルを取得
  wsDir = StrConv(Left(f.Name, 1), vbKatakana)
  If FolderExists(PutDir & "\" & wsDir) = False Then
   MkDir PutDir & "\" & wsDir
  End If
  KeyPos = InStr(f.Name, KeyTex)
  PutFName = Left(f.Name, KeyPos)
  PutFName = PutDir & "\" & wsDir & "\" & PutFName & "." & getExtxt(f.Name)
  FileCopy f.Path, PutFName
 Next
 Set FSO = Nothing
End Sub

'拡張子を取得する関数
Function getExtxt(FPath) As String
 Dim FSO As New Scripting.FileSystemObject
 Dim filePath As String
 Dim ExtentionName As String
 getExtxt = FSO.GetExtensionName(FPath)
 Set FSO = Nothing
End Function

'フォルダーの有無判定
Function FolderExists(folder_path As String) As Boolean
 Dim FSO As New Scripting.FileSystemObject
 If FSO.FolderExists(folder_path) Then
  FolderExists = True
 Else
  FolderExists = False
 End If
 Set FSO = Nothing
End Function
結果を報告する
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。
関連するQ&A
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

ピックアップ

ページ先頭へ