VBA でテキストファイルに読み書き

質問

エクセル2000のVBAを使用しています。
ブックAファイル名をブックBのセルに入力して、ブックAをインデックスの様な扱いのファイルを作成使用としたのですが、ブック間で変数のやり取りは出来ないと思います。できるんですか？？
　その為、txtファイルを変数代わりに使おうと思っているのですが、
入出力の方法が良くわかりません。
　簡単にブックBのセルの値をtxtファイルに書き込んでブックAで、
そのtxtファイルを読み込む様なVBAのコード教えて下さい。
初心者ですけど・・。

回答No.3

OtenkiAme · ベストアンサー

こんにちは。

補足の内容を拝見いたしました。

> そこでインデックスファイルを作成して、
> そこに受注番号、機種名、数量　等を自動入力させて
> 目次の様なファイルを作りたいと言う事です。
> 更に、ハイパーリンクを組み込み、クリック一発で
> 過去の受注ファイルを開く事が出来る様にしたいのです。
下記のコードは、関係企業から
「部品ごとに分けられたファイルのリストを作りたい」
との相談を受けて電話でのやりとりで作成したコードです。

質問者さんが意図した内容の処理に似てると思いましたので
コメントを読みながら処理の参考にしてみてください。

なお、私は現物のファイルも見ていませんし、現場にも出ていませんが、
ちゃんと目的の処理が実行されていると報告を受けています。

頭の中では、処理の内容が整理されていると思いましたので、
処理の手順を書き出して、その手順に従ってコードを組めば
意図した内容の処理ができると思います。
頑張ってください。

Sub Sample()

Dim OldSheetsCount As Long

Dim OpenFile As Variant, myBookName As String, _
　　myPath As String, myFile As String, myFileName As String, _
　　NewBook As Workbook, ListSht As Worksheet, _
　　OpenBook As Workbook, OpenSht As Worksheet, _
　　Target As Range, i As Long

'読み込むフォルダを指定する
OpenFile = Application.GetOpenFilename( _
　　FileFilter:="エクセル ファイル (*.xls), *.xls", _
　　Title:="部品コードのブックを一つ選択して［開く］をクリックしてください。", _
　　MultiSelect:=False)

'キャンセルされたら終了
If OpenFile = False Then MsgBox "処理を中止します。": Exit Sub

'画面更新を止める
Application.ScreenUpdating = False

'キャンセルされなかったら処理を継続
'新規シートを一枚にセットして新規ブックを作る
With Application
　　OldSheetsCount = .SheetsInNewWorkbook
　　.SheetsInNewWorkbook = 1
　　Set NewBook = .Workbooks.Add
　　.SheetsInNewWorkbook = OldSheetsCount
End With

'記録用ワークシート
Set ListSht = NewBook.Worksheets(1)

'項目名の記入
With ListSht.Range("A1:C1")
　　.Value = Array("部品コード", "型式名", "登録ブック名")
　　.Interior.ColorIndex = 6
　　.HorizontalAlignment = xlCenter
End With

'ウィンドウ枠の固定
Application.GoTo Reference:=ListSht.Range("A2")
ActiveWindow.FreezePanes = True

'このブック名
myBookName = ThisWorkbook.Name

'ドライブとパスの変更
myPath = Left(OpenFile, Len(OpenFile) - InStr(1, StrReverse(OpenFile), "\"))
ChDrive myPath
ChDir myPath

'Dir関数によりフォルダ内のすべてのブックに対して繰り返し
myFile = Dir("*.xls")
Do While myFile <> ""

　　'自ブックでない時
　　If myFile <> myBookName Then

　　　　'読み取り専用で開く
　　　　Set OpenBook = Workbooks.Open(Filename:=myFile, ReadOnly:=True)

　　　　'開いたブックの最初のシート
　　　　Set OpenSht = OpenBook.Worksheets(1)

　　　　With ListSht

　　　　　　'シートから"型式名"を探す
　　　　　　On Error Resume Next
　　　　　　Set Target = OpenSht.Cells.Find(What:="型式名", _
　　　　　　　　After:=OpenSht.Range("A1"), LookIn:=xlFormulas, _
　　　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows)
　　　　　　On Error GoTo 0

　　　　　　'"型式名"があったら
　　　　　　If Not Target Is Nothing Then

　　　　　　　　'カウンタリセット
　　　　　　　　i = 1
　　　　　　　　Do

　　　　　　　　　　'すべての型式名を取得してシートに書き込む
　　　　　　　　　　With .Range("B" & .Rows.Count).End(xlUp).Offset(1)
　　　　　　　　　　　　.NumberFormat = "@"
　　　　　　　　　　　　.Value = Target.Offset(i).Value
　　　　　　　　　　End With

　　　　　　　　　　'ハイパーリンクを設定する
　　　　　　　　　　.Hyperlinks.Add _
　　　　　　　　　　　　Anchor:=.Range("C" & .Rows.Count).End(xlUp).Offset(1), _
　　　　　　　　　　　　Address:=OpenBook.FullName, TextToDisplay:=OpenBook.Name

　　　　　　　　　　'カウンタ加算
　　　　　　　　　　i = i + 1

　　　　　　　　Loop Until Target.Offset(i).Value = ""

　　　　　　　　'ブック名を部品コードとしてシートに書き込む
　　　　　　　　With .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(i - 1)
　　　　　　　　　　.NumberFormat = "@"
　　　　　　　　　　.Value = Replace(myFile, ".xls", "")
　　　　　　　　End With

　　　　　　End If
　　　　End With

　　　　'開いたブックを閉じる
　　　　OpenBook.Close Savechanges:=False
　　　　Set OpenSht = Nothing
　　　　Set OpenBook = Nothing

　　End If

　　'次のブック
　　myFile = Dir()

Loop
'↑ここまで繰り返し

'アクティブセル領域に対し、列幅自動調整、部品コード順に並べ替え
With ListSht.Range("A1").CurrentRegion

　　.EntireColumn.AutoFit
　　.Sort Key1:=.Parent.Parent.Parent.Range("A2"), Order1:=xlAscending, _
　　　　Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
　　　　Orientation:=xlTopToBottom, SortMethod:=xlPinYin

　　'もし書き込みデータがなかったらブックを閉じる
　　If .Cells.Count = 3 Then
　　　　Application.DisplayAlerts = False
　　　　NewBook.Close Savechanges:=False
　　　　Application.DisplayAlerts = True
　　End If

End With

'シート名を現在の日付& 時刻にする
ListSht.Name = Format(Now, "yyyy年mm月dd日hh時mm分ss秒")

'画面更新を有効
Application.ScreenUpdating = True

Set ListSht = Nothing
Set NewBook = Nothing

End Sub

お礼

有り難うございました。
非常に参考になり、思った事が
実現しました。
本当に有り難うございました。

回答No.2

fujillin

であればこんな感じ？

INDEXファイルを Index.xls と仮定し、記入するのはIndex.xlsのSheet(1)のA列に順に記載してゆくものと決め打ちにしています。
また、Index.xlsとデータファイルは同じフォルダ内にあるものと仮定しています。
フォルダが違う場合には、ThisWorkbook.Path を利用している部分を修正する必要があります。

Function Registは、bName（=登録しようとするファイル名）が既にあるかをチェックし、新規登録を行った場合はTrue、既に登録済で何もしなかった場合はFalseを返します。
（常に新規登録しか起こり得ないのであれば、登録済みかをチェックする必要もありませんので、かなり処理をはぶくことが可能です。）

Function Regist(bName As String) As Boolean
Dim wb As Workbook, c As Range
Dim rw As Long, bPath As String
Const index = "Index.xls" '// INDEXファイルのファイル名

Application.ScreenUpdating = False '// 必要に応じて表示をOFF
bPath = ThisWorkbook.Path & "\"
Set wb = Workbooks.Open(bPath & index)
wb.Worksheets(1).Activate
rw = Cells(Rows.Count, 1).End(xlUp).Row
Set c = Nothing

If (rw = 1) And (Cells(1, 1) = "") Then 　'//1行目も未記入（新規シート）
rw = 0
Else
'// 同じブック名が既にあるかをチェック
Set c = Range("A1:A" & rw).Find(bName, LookIn:=xlValues, LookAt:=xlWhole)
End If
If c Is Nothing Then '// リンクを登録
ActiveSheet.Hyperlinks.Add Anchor:=Cells(rw + 1, 1), _
Address:=bPath & bName, TextToDisplay:=bName
Regist = True
Else
Regist = False
End If

Application.DisplayAlerts = False '// 保存時の確認メッセージを回避
wb.Close (Regist)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function

お礼

有り難うございました。
非常に参考になり、
予定していた事が実現しました。

ありがとうございました。

回答No.1

fujillin

＞ブック間で変数のやり取りは出来ないと思います。できるんですか？？
変数のやり取りというより、データの記入でよいのですよね？できますよ。

具体的に何をやりたいのか、いまひとつよくわかりませんので、以下、簡単なサンプル。
新しいブックを作成して、そのブックのシート1のA1に、自分のブック名を書き込むというものです。

セルやレンジを指定するときには、きちんと識別できるように
　Workbook.WorkSheet.Range　の形で指定してあげる必要があります。

Sub test()
Dim filename As String
Dim wb As Workbook

filename = ThisWorkbook.Name
Set wb = Workbooks.Add
wb.Sheets(1).Cells(1, 1).Value = filename
End Sub

テキストファイルの読み書きも当然できますが、↑でもお望みのことができるのではないでしょうか？

補足

＞　ありがとうございました。
　でも、私の説明の仕方が少し、良くなかった様なので再度説明します。

　私は製造業の課長ですが、我々の生産は受注生産で
多くの機種が受注番号を付けられ、我々のところに来て
生産が行われます。

製造課に於いては、1つの受注オーダーに於いて、１つのエクセルファイルを作ります。
その中に生産時の情報が記録として、入力されます。（１オーダー、１ファイル））

そのファイルのセルA1には、受注番号を入力しますので
A1の受注番号を利用して、そのファイル自身に名前を付けて保存します。
ここまでは自分でマクロ組みました。

この様にしていくと、1ヶ月にかなりの数のファイルが出来ます。
（受注の数だけ出来る事になる。）

そこでインデックスファイルを作成して、
そこに受注番号、機種名、数量　等を自動入力させて
目次の様なファイルを作りたいと言う事です。
更に、ハイパーリンクを組み込み、クリック一発で
過去の受注ファイルを開く事が出来る様にしたいのです。
（ちなみに過去の受注ファイルは、生産終了後、たびたび使用する為）

製品によっては、日をまたいで生産する製品もあるし、
又、半分だけ生産して、一週間後に再開する製品もあります。
その為、受注ファイルが名前を付けて保存する時に
同時にINDEXファイルにも登録したいのです。　
そうすれば、翌日、または一週間後にも、INDEXファイルから
簡単に開く事が可能になるからです。

　新規に作成した受注ファイルは、その度に名前が変わる事になる為
名前を付けて保存する際にファイル名を変数に代入しました。
　その後、自動でINDEXファイルを開き、OPENイベントで
変数を指定のセルに入力しようとしたんですが、だめでした。

　ちなみ、上記のコード、今からチャレンジしてみます。