Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


18513 / 76732 ←次へ | 前へ→

【63660】ご協力お願いします。
質問  天馬  - 09/11/27(金) 9:33 -

引用なし
パスワード
   教えてください。 m(_ _)m
C:\syouhinnmaster\textと言うフォルダに毎日作られる
商品リスト_2009年11月16日.csv(日付は毎日変わる)言う名前のファイルを
商品リスト_.csvと変更して、同ファイル内に変更後の名前で保存したくて
色々なサイトを調べてやったのですが、実行時にファイルの選択とフォルダの
参照を尋ねられるので、そこを、一発でC:\syouhinnmaster\textの中にある
商品リスト_2009年11月16日.csv(日付は毎日変わる)ファイルを選ぶように
組みたいのですが、お知恵をお貸し頂けないでしょうか?
宜しくお願いします。

Sub ファイル名変換()

  Dim FileNamePath, FileName, NewFileName, FolderPath, tail As String
  Dim i As Integer
  
  'ファイルのパスを取得
  FileNamePath = SelectFileNamePath
  
  'ParentPath と ファイル名の分離
  For i = Len(FileNamePath) To 1 Step -1
    If Mid(FileNamePath, i, 1) = "\" Then
      Exit For
    End If
  Next
  
  '参考:フォルダのパスを取得'
  FolderPath = Mid(FileNamePath, 1, i - 1)

  'ファイル名を取得
  FileName = Mid(FileNamePath, i + 1, Len(FileNamePath))
  
  'ファイル名から拡張子の分離
  For i = Len(FileName) To 1 Step -1
    If Mid(FileName, i, 1) = "." Then
      Exit For
    End If
  Next
  
  '拡張子
  tail = Mid(FileName, i + 1, Len(FileName))
  
  NewFileName = "商品リスト_"
  
  '移動先のフォルダの選択
  FolderPath = FolderSelect
  
  'ファイルの移動
  Name FileNamePath As FolderPath & "\" & NewFileName & "." & tail

End Sub

Function SelectFileNamePath() As String
  SelectFileNamePath = Application. _
        GetOpenFilename("ファイルの選択 (*.*),*.*")
End Function


Function FolderSelect() As String
  
  Dim Shell As Object
  
  Set Shell = CreateObject("Shell.Application") _
  .BrowseForFolder(0, "フォルダを選択してください", 0, "デスクトップ")
  
  If Shell Is Nothing Then
    FolderSelect = "C;musasi\TEXT\"
  Else
    FolderSelect = Shell.Items.Item.Path
  End If

End Function
2 hits

【63660】ご協力お願いします。 天馬 09/11/27(金) 9:33 質問
【63661】Re:ご協力お願いします。 Yuki 09/11/27(金) 10:51 発言
【63662】Re:ご協力お願いします。 天馬 09/11/28(土) 11:01 お礼

18513 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free