excel 2003から VBAのreplaceマソッドで文字を置換する方法を教えてください

質問

エクセルファイルシートをセミコロン区切りのテキストファイルに変換して出力したいです。
エクセル2002では以下のVBAで書いたマクロがちゃんと動いてTABをセミコロンに置換できますが、エクセル2003では置換ができなくてデータとデータの間にTABまま出力されます。
Public Sub ExportWorksheetWithCustomDelimiter( _
ByVal SourceWorksheet As Variant, _
ByVal FilePath As String, _
ByVal Delimiter As String)

' Exports the source worksheet as a text file with a custom field delimiter.
' ExportWorksheetWithCustomDelimiter(SourceWorksheet, FilePath, Delimiter)
' SourceWorksheet - The name of or a reference to a worksheet.
' FilePath - The full path to the export file.
' Delimiter - One or more characters to use as the field delimiter.

Dim DisplayAlerts As Boolean
Dim FileNumber As Long
Dim FileData As String

If VarType(SourceWorksheet) = vbString Then SourceWorksheet = ActiveWorkbook.Sheets(SourceWorksheet).Name

' Create copy of source worksheet in new workbook
Sheet1.Copy

' Save copy as tab delimited text file and close
DisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=FilePath, FileFormat:=xlText
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = DisplayAlerts

' Read file into string variable and delete file
FileNumber = FreeFile
'Open FilePath For Binary Access Read Write As FileNumber
Open FilePath & ".txt" For Binary Access Read Write As FileNumber
FileData = StrConv(InputB(LOF(FileNumber), FileNumber), vbUnicode)
Close FileNumber
Kill FilePath & ".txt"

' Replace all tabs with special character
FileData = Replace(FileData, Chr(9), Delimiter)

' Right modified text back out to same file
Open FilePath For Binary Access Read Write As FileNumber
Put FileNumber, , FileData
Close FileNumber
End Sub
上のマクロの実行後の結果は次と同じです。
エクセル2002からマクロの実行結果：AAA;BBB;CCC;DDD;EEE;FFF
エクセル2003からマクロの実行結果：AAA BBB CCC DDD EEE FFF
解決方法を教えてください。
ぜひよろしくお願いします。
ありがとうございます。

回答No.1

pkh4989 · ベストアンサー

以下のように変更してみてください。

Sub Main()
　　Call ExportWorksheetWithCustomDelimiter("TEST", "C:\TEST", ";")　　 '←起動方法
End Sub

Function ExportWorksheetWithCustomDelimiter( _
　　ByVal SourceWorksheet As Variant, _
　　ByVal FilePath As String, _
　　ByVal Delimiter As String)

　　' Exports the source worksheet as a text file with a custom field delimiter.
　　' ExportWorksheetWithCustomDelimiter(SourceWorksheet, FilePath, Delimiter)
　　' SourceWorksheet - The name of or a reference to a worksheet.
　　' FilePath - The full path to the export file.
　　' Delimiter - One or more characters to use as the field delimiter.

　　Dim DisplayAlerts As Boolean
　　Dim FileNumber As Long
　　Dim FileData As String

　　If VarType(SourceWorksheet) = vbString Then SourceWorksheet = ActiveWorkbook.Sheets(SourceWorksheet).Name
　　' Create copy of source worksheet in new workbook
　　Sheet1.Copy

　　' Save copy as tab delimited text file and close
　　DisplayAlerts = Application.DisplayAlerts
　　Application.DisplayAlerts = False
　　ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlText
　　ActiveWorkbook.Close SaveChanges:=False
　　Application.DisplayAlerts = DisplayAlerts

　　' Read file into string variable and delete file
　　FileNumber = FreeFile
　　'Open FilePath For Binary Access Read Write As FileNumber
　　Open FilePath & ".txt" For Binary Access Read Write As FileNumber
　　FileData = StrConv(InputB(LOF(FileNumber), FileNumber), vbUnicode)
　　Close FileNumber
　　Kill FilePath & ".txt"

　　' Replace all tabs with special character
　　FileData = Replace(FileData, Chr(9), Delimiter)

　　' Right modified text back out to same file
　　'Open FilePath For Binary Access Read Write As FileNumber
　　Open FilePath & ".txt" For Binary Access Read Write As FileNumber　 '←変更
　　Put FileNumber, , FileData
　　Close FileNumber
End Function

補足

pkh4989さん、回答ありがとうございました。
私の質問が悪かったです。
実は"エクセルファイルシートをセミコロン区切りのテキストファイルに変換して出力したいです。"　だけじゃなくて、*.ABCDのようにお客さんからの要望に合わせてファイルの拡張子も変更して出力する仕様です。でもその拡張子の変更はすでに解決したので今回は説明しませんでした。
Kill FilePath & ".txt"　このコードから最終的にテキストファイルを削除する処理を行いますので、もう一度下で以下の処理をするなら再度テキストファイルが作成されますので作りたい仕様とは違います。
Open FilePath & ".txt" For Binary Access Read Write As FileNumber　 '←変更
たぶん
FileData = Replace(FileData, Chr(9), Delimiter)
このコードが問題があるんじゃないかなと思いますが、まだ良く分からなくって困っています。
また、よろしくお願いします。

回答No.5

end-u

質問者さんご提示のコードで2003でも
FileData = Replace(FileData, Chr(9), Delimiter)
この箇所で置換されますから、Replaceメソッドの問題ではないです。
...という事を皆さんおっしゃってるのだと思います。
2002で実際に動いているというコードで再確認される事をおすすめします。

もし、実際のコードも提示コードのままなら、関係ない箇所ですけど
>If VarType(SourceWorksheet) = vbString Then SourceWorksheet = ActiveWorkbook.Sheets(SourceWorksheet).Name
>' Create copy of source worksheet in new workbook
>Sheet1.Copy
SourceWorksheetは意味がなく、シートオブジェクトSheet1を常にコピーしてますから
それでいいのか仕様を確認しておかれたほうが良いでしょう。

また、セルテキスト内の『,』や『"』の扱いによっては、直接テキストデータを作る方法も検討してもいいかもしれません。
あと、データ量が多ければ"VBScript.RegExp"のReplaceメソッドも検討したほうが良いかも。以下参考です。

Sub try()
　　Const outfile = "c:\test.abcd"
　　Const CLSID_DataObject = "1C3B4210-F441-11CE-B9EA-00AA006B1A69"
　　Const DLM = vbTab
　　Const REP = ";"
　　Dim tmp As String
　　Dim n As Long

　　Sheets(1).UsedRange.Copy
　　'DataObjectを使ってClipboardから文字列を取得します。
　　'MicrosoftForms2.0 ObjectLiblaryに事前バインディングする方法でも可
　　With GetObject("new:" & CLSID_DataObject)
　　　　.GetFromClipboard
　　　　tmp = .GetText
　　End With
　　Application.CutCopyMode = False
　　'RegExp.Replaceメソッドで置換
　　With CreateObject("VBScript.RegExp")
　　　　.Global = True
　　　　.Pattern = DLM
　　　　tmp = .Replace(tmp, REP)
　　End With
　　n = FreeFile
　　Open outfile For Output As #n
　　Print #n, tmp
　　Close #n
End Sub

お礼

ご丁寧な回答ありがとうございました。
でも、はじめにこのサイトに質問したのでまだ使い方などがよく知らなくてポイント制度とか、良回答20ポイント、10ポイント制度もあんまりつける方法がよく分からなかったので次回にちゃんとポイントを送ります。それではまたよろしくお願いします。

補足

end-uさん、早速の回答ありがとうございます。参考にさせていただきます。

回答No.4

pkh4989

お早うございます。
No1 です。
No2 さんが良い回答をしたので、必要ないと思いますが、
　　zyh_uk さんのソースをそのまま生かして修正すると、以下の２箇所です。( & ".txt" を削除)

Sub Main()
　　Call ExportWorksheetWithCustomDelimiter("TEST", "C:\TEST.ABCD", ";")　　 '←起動方法
End Sub

Function ExportWorksheetWithCustomDelimiter( _
　　ByVal SourceWorksheet As Variant, _
　　ByVal FilePath As String, _
　　ByVal Delimiter As String)

　　' Exports the source worksheet as a text file with a custom field delimiter.
　　' ExportWorksheetWithCustomDelimiter(SourceWorksheet, FilePath, Delimiter)
　　' SourceWorksheet - The name of or a reference to a worksheet.
　　' FilePath - The full path to the export file.
　　' Delimiter - One or more characters to use as the field delimiter.

　　Dim DisplayAlerts As Boolean
　　Dim FileNumber As Long
　　Dim FileData As String

　　If VarType(SourceWorksheet) = vbString Then SourceWorksheet = ActiveWorkbook.Sheets(SourceWorksheet).Name
　　' Create copy of source worksheet in new workbook
　　Sheet1.Copy

　　' Save copy as tab delimited text file and close
　　DisplayAlerts = Application.DisplayAlerts
　　Application.DisplayAlerts = False
　　ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlText
　　ActiveWorkbook.Close SaveChanges:=False
　　Application.DisplayAlerts = DisplayAlerts

　　' Read file into string variable and delete file
　　FileNumber = FreeFile
　　'Open FilePath For Binary Access Read Write As FileNumber
　　Open FilePath For Binary Access Read Write As FileNumber　　　　　　'←変更
　　FileData = StrConv(InputB(LOF(FileNumber), FileNumber), vbUnicode)
　　Close FileNumber
　　Kill FilePath　　　 '←変更

　　' Replace all tabs with special character
　　FileData = Replace(FileData, Chr(9), Delimiter)

　　' Right modified text back out to same file
　　Open FilePath For Binary Access Read Write As FileNumber
　　Put FileNumber, , FileData
　　Close FileNumber
End Function

お礼

ご丁寧な回答ありがとうございました。
でも、はじめにこのサイトに質問したのでまだ使い方などがよく知らなくてポイント制度とか、良回答20ポイント、10ポイント制度もあんまりつける方法がよく分からなかったので次回にちゃんとポイントを送ります。それではまたよろしくお願いします。

補足

参考になりました、ご丁寧に教えていただきまして本当にありがとうございました。

回答No.3

redfox63

FileData = StrConv(InputB(LOF(FileNumber), FileNumber), vbUnicode)
を
FileData = Input(LOF(FileNumber), FileNumber)
テキストファイルならわざわざBinayで読む必要も無いように思うのですが …
Input関数なら S-JIS -> Unicode は自動的に変換しますよ
つまりStrConvは必要ありません

当方の WinXPSP3 + Exce2003SP3では Tab->;は Replaceで動作しますよ
動作検サンプル
Sub M1()
Dim ss(5) As String, n As Integer
Dim sa As String
Dim bb() As Byte
Dim sb As String
　　' テスト文字列組み立て
　　For n = 0 To 5
　　　　ss(n) = String(5, Chr(Asc("A") + n))
　　Next
　　sa = Join(ss, vbTab)
　　' サンプルファイル出力
　　Open "sample.txt" For Output As #1
　　Print #1, sa
　　Close #1

　　' バイナリオープン
　　Open "sample.txt" For Binary Access Read As #1
　　' Byte配列に読み込み
　　bb = Input(LOF(1), 1)
　　Close #1
　　' UnicodeのByte配列ならそのままString型へ代入
　　sb = bb

　　sb = Replace(sb, Chr(9), ";")
　' vbTabでも同様にOK
　' sb = Replace(sb, vbTab, ";")
　　Open "sampleT.txt" For Binary Access Write As #1
　　Put #1,,sb
　　Close #1
End Sub

お礼

ご丁寧な回答ありがとうございました。
でも、はじめにこのサイトに質問したのでまだ使い方などがよく知らなくてポイント制度とか、良回答20ポイント、10ポイント制度もあんまりつける方法がよく分からなかったので次回にちゃんとポイントを送ります。それではまたよろしくお願いします。

補足

返事が遅れましてごめんなさい。
丁寧に回答していただきありがとうございます。

回答No.2

argument

はじめまして　zyh_uk　さん
せっかくの休日が終わってもうこんな時間です。あぁ一体私は何に時間を使ったと言うのか。
まぁそれは良いでしょう。大切なのは回答する事でしたね。
「日本語でおｋ」
知り合いに便利なスクリプトができたので送ったときに言われた一言です(きっと中身を見たのでしょう…)。

確かにサンプルソースがあるのでほかの方々(通称丸投げ組み)とは違いソースは書いてあるのはわかりやすいですね。
ですが、読みづらいです。
あなたの会社がどのようなコーディングスタイルかは知りませんがコメントが英語なだけでくらりと来ます。
まぁそれは良いでしょう。見た瞬間すべてコメントは削除したので。
それよりも引数の説明はするべきでしょう。我々回答者は貴方がどのような値を渡したいのか知りません。
引数名がそれっぽい英語であっても回答者のほとんどは日本人なので直感的にわからない。
まぁまぁそれも良しとしましょう。回答者が減る程度の問題です。

さてでは下記を回答とします。

Sub test()
ExportWorksheetWithCustomDelimiter "Sheet1", CreateObject("WScript.Shell").SpecialFolders("desktop") & "\test.ABCD", ";"
End Sub

Public Sub ExportWorksheetWithCustomDelimiter( _
ByVal SourceWorksheet As Variant, _
ByVal FilePath As String, _
ByVal Delimiter As String)

' Exports the source worksheet as a text file with a custom field delimiter.
' ExportWorksheetWithCustomDelimiter(SourceWorksheet, FilePath, Delimiter)
' SourceWorksheet - The name of or a reference to a worksheet.
' FilePath - The full path to the export file.
' Delimiter - One or more characters to use as the field delimiter.

Dim DisplayAlerts As Boolean
Dim FileNumber As Long
Dim FileData As String

If VarType(SourceWorksheet) = vbString Then SourceWorksheet = ActiveWorkbook.Sheets(SourceWorksheet).Name

' Create copy of source worksheet in new workbook
Sheet1.Copy

' Save copy as tab delimited text file and close
DisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlText
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = DisplayAlerts

'きっとあなたの望むであろう至れり尽くせり処理
Set myfso = CreateObject("Scripting.FileSystemObject"): myfso.CreateTextFile(FilePath).write Replace(myfso.OpenTextFile(FilePath).readall, vbTab, Delimiter): Set myfso = Nothing

End Sub

どうでしょうか？実行してみましたか？貴方の望む;(セミコロン)区切りのデータが引数で渡した拡張子で出力されました。
はい。問題解決ですね。

ん、何ですか？聞きたいことがある？あぁ、私のヴァージョンは2003なので安心してください。
なので2003で動きます。2002でも動くことでしょう。
ん？違う？あぁマソッドではなくメソッドではないかって事ですか？あぁそうですねそうかもしれません。
え？違うのですか？私の読み込み処理、ファイル削除、置換処理はどこいったかって？
いや、言われたとおりの処理を書いただけですよ。長いので消して私好みに書き換えましたが…。
どうやらタブ区切りテキストはすでに作成しているのでそれを読み込みつつ置換しつつ書き込んだだけですよ。

追加処理・処理違い・補足等あればいってください。

お礼

ご丁寧な回答ありがとうございました。
でも、はじめにこのサイトに質問したのでまだ使い方などがよく知らなくてポイント制度とか、良回答20ポイント、10ポイント制度もあんまりつける方法がよく分からなかったので次回にちゃんとポイントを送ります。それではまたよろしくお願いします。

補足

返事が遅くなりましたが回答いただきありがとうございました。
なんとかうまくいきましたので助かりました！