[[20170510191533]]　『どの端末でもデスクトップのファイルをリネームし』（ゆうきや）　ページの最後に飛ぶ

『どの端末でもデスクトップのファイルをリネームしてインポートしたい』（ゆうきや）

お世話になります。

現在、デスクトップに落としてくる「test.dat」を「test.csv」にリネームし、
workシートにインポートするVBAを作成しています。

ご指導を頂き、修正したのですが「?@」の箇所で"実行時エラー1004 外部データ範囲を更新する
ためのテイストファイルが見つかりません。テキストファイルが移動または名前が変更されて
いないことを確認し、再度実行してください" というエラーが出力されてしまいます。

解決法をご教授して頂きたく投稿させて頂きます。

以下にVBAを記します。

Sub test_import()
'
' test_import Macro

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

 Const OLD_EXTENSION As String = "test.dat"
 Const NEW_EXTENSION As String = "test.csv"

Dim SAVE_DIR As String
Dim wsh As Object
Set wsh = CreateObject("Wscript.Shell")

 SAVE_DIR = wsh.SpecialFolders("Desktop")
Set wsh = Nothing

Dim OldFName As String
Dim NewFName As String

 OldFName = Dir(SAVE_DIR & "*" & OLD_EXTENSION)

Do While Len(OldFName) <> 0

 OldFName = SAVE_DIR & OldFName
 NewFName = _
 Left(OldFName, Len(OldFName) - Len(OLD_EXTENSION)) & NEW_EXTENSION

 FileCopy OldFName, NewFName
 Kill OldFName
 OldFName = Dir()
Loop

 Range("A2", Cells(Rows.Count, 1).End(xlDown)).EntireRow.Delete

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & SAVE_DIR & "test.csv", Destination:=Range("$A$2"))

 .Name = "test"
 .FieldNames = True
 .RowNumbers = False
 .FillAdjacentFormulas = False
 .PreserveFormatting = True
 .RefreshOnFileOpen = False

 .RefreshStyle = xlOverwriteCells
 .SavePassword = False
 .SaveData = True

 .AdjustColumnWidth = True
 .RefreshPeriod = 0
 .TextFilePromptOnRefresh = False
 .TextFilePlatform = 932
 .TextFileStartRow = 1
 .TextFileParseType = xlDelimited
 .TextFileTextQualifier = xlTextQualifierDoubleQuote
 .TextFileConsecutiveDelimiter = True
 .TextFileTabDelimiter = True
 .TextFileSemicolonDelimiter = False
 .TextFileCommaDelimiter = True
 .TextFileSpaceDelimiter = True
 .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
 .TextFileTrailingMinusNumbers = True
 .Refresh BackgroundQuery:=False ← ?@ここでエラーが出て止まってしまいます

End With

 Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "work"

 Application.Goto Sheets("work").Range("A1")

　　　　　　　　　・
　　　　　　　　　・
　　　　　　　　　・

よろしく願い致します。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

＞ご指導を頂き、修正したのですが

リンクを貼っていただけるとよいかもしれません。

＞OldFName = Dir(SAVE_DIR & "*" & OLD_EXTENSION)

ここがおかしい気がしますが？　＊でなく　\　では？

他にも、拡張子を変える必要があるのか？
Do While～loopで何をしようとしているのか？

とりあえず、ステップ実行で期待通り動いているか確認されてはどうでしょうか。

（マナ） 2017/05/10(水) 20:32

＞workシートにインポートするVBAを作成しています。

ならば

＞Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "work"

これをインポートする前に持ってこないといけないのでは？

（マナ） 2017/05/10(水) 21:53

マナ様

ご返信、ありがとうございます。

いろいろとトライしていて

「SAVE_DIR = wsh.SpecialFolders("Desktop")」のあとに「& "\"」を付けて実行した結果

エラーなく処理が完結いたしました。

ご教授、ありがとうございました。
（ゆうきや） 2017/05/12(金) 10:09

コメント返信：

[ 一覧(最新更新順) ]

[[20170510191533]] 『どの端末でもデスクトップのファイルをリネームし』（ゆうきや） ページの最後に飛ぶ

[[20170510191533]]　『どの端末でもデスクトップのファイルをリネームし』（ゆうきや）　ページの最後に飛ぶ