エクセルのマクロでHTMLファイルを出力するには

質問

エクセルのマクロでHTMLファイルを出力するには

下記アドレスのソースをもとに、エクセルでHTMLファイルを複数出力できたらと考えています。

内容は、sheet1のＡ列にテキストが入っていると、それを任意のファイル名（ダイアログ）でテキストとして保存が可能になるソースです。

ttp://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_040.html

出来ればこれを以下のように変えたいと考えております。

●シート名「1」～「50」の計50シートのＡ列のテキストを、
それぞれのシート名＋任意の文字列で保存をしたい。

●ファイル名の任意の文字列については、シート内のセル
（例：sheet1のＡ４）に記載されている内容としたい。

●ファイル形式は、HTML形式で保存をしたい。

●保存先のフォルダは任意のディレクトリ内
（例：C:\Documents and Settings\All Users\デスクトップ）の配下に、
シート内のセル（例：sheet1のＡ３）に記載されている内容を
フォルダ名として、新規に作成し、その中に保存したい。

恐れ入りますが、ご回答よろしくお願いいたします。

回答No.2

DOUGLAS_ · ベストアンサー

#1 DOUGLAS_ です。
　[戻る] つもりが [回答] してしまいました。

If Dir(FOLDER_NAME) = "" Then MkDir FOLDER_NAME
の行を
If Dir(FOLDER_NAME, vbDirectory) = vbNullString Then MkDir FOLDER_NAME
と差し替えてください。

お礼

下に同じく、有難うございました！

回答No.1

DOUGLAS_

お示しの ＵＲＬ の「FSO(FileSystemObject)でのサンプル」の方を使ってみます。

　[Visual Basic Editor]（ＶＢＥ）- [ツール(T)] - [参照設定(R)...] = [参照設定 - VBAProject] - [参照可能なライブラリ ファイル(A):] から「Microsoft Scripting Runtime」に チェック を付けて [OK] しておいてください。

Option Explicit

' 参照設定：Microsoft Scripting Runtime
Sub WRITE_TextFile3()
　Dim strFILENAME As String　　　　 ' 保存ファイル名
　Dim FSO As New FileSystemObject　 ' FileSystemObject
　Dim TS As TextStream　　　　　　　' TextStream
　Dim strREC As String　　　　　　　' 書き出すレコード内容
　Dim GYO As Long　　　　　　　　　 ' 収容するセルの行
　Dim GYOMAX As Long　　　　　　　　' データが収容された最終行
　Dim strFolder As String　　　　　 ' 保存先のディレクトリ
　Dim SheetCnt As Long　　　　　　　' シート数
　Dim FOLDER_NAME As String　　　　 ' 保存先フォルダ

　'保存先のフォルダは任意のディレクトリ内
　strFolder = "C:\Documents and Settings\All Users\デスクトップ"
　For SheetCnt = 1 To Worksheets.Count
　　Sheets(SheetCnt).Select
　　'それぞれのシート名＋任意の文字列で保存をしたい。
　　'ファイル名の任意の文字列については、シート内のセル（例：sheet1のＡ４）に記載されている内容としたい。
　　'ファイル形式は、HTML形式で保存をしたい。
　　strFILENAME = "\" & ActiveSheet.Name & "_" & Range("A4").Value & ".html"
　　'シート内のセル（例：sheet1のＡ３）に記載されている内容を
　　'フォルダ名として、新規に作成し、その中に保存したい。
　　FOLDER_NAME = strFolder & "\" & Range("A3").Value
　　If Dir(FOLDER_NAME) = "" Then MkDir FOLDER_NAME
　　' 最終行の取得
　　GYOMAX = Range("A65536").End(xlUp).Row
　　' 指定ファイルをOPEN(出力モード)
　　Set TS = FSO.CreateTextFile( _
　　　FILENAME:=FOLDER_NAME & strFILENAME, _
　　　Overwrite:=True)
　　' 1行目から開始
　　GYO = 1
　　' 最終行まで繰り返す
　　Do Until GYO > GYOMAX
　　　' A列内容をレコードにセット(先頭は2行目)
　　　strREC = Cells(GYO, 1).Value
　　　' レコードを出力
　　　TS.WriteLine strREC
　　　' 行を加算
　　　GYO = GYO + 1
　　Loop
　　' 指定ファイルをCLOSE
　　TS.Close
　Next
　Set TS = Nothing
　Set FSO = Nothing
End Sub

お礼

早速試させて頂きました。
思った通りの物が出来て感動しております。

ご回答有難うございました！