Sub Sample3()
Dim OpenFileName As String, SheetName As String, Target As String, buf As String
Dim i As Long, TargetCol As Long, GetNames()
''対象ブックを選択します
OpenFileName = Application.GetOpenFilename("Microsoft Excel ブック,*.xls")
If OpenFileName = "False" Then Exit Sub
''ファイル名に[]を付ける
OpenFileName = Replace(OpenFileName, Dir(OpenFileName), "[" & Dir(OpenFileName) & "]")
''対象ワークシート名を取得
SheetName = InputBox("読み込むワークシート名を入力してください。")
If SheetName = "" Then Exit Sub
Target = "'" & OpenFileName & SheetName & "'!"
''ワークシート名が正しいかどうか、まず読み込んでみる
On Error Resume Next
buf = ExecuteExcel4Macro(Target & "R1C1")
If Err <> 0 Then
MsgBox "ワークシート [ " & SheetName & " ] を読めませんでした。", vbExclamation
Exit Sub
End If
On Error GoTo 0
''[名前]フィールドを探す
For i = 1 To 256
If ExecuteExcel4Macro(Target & "R1C" & i) = "名前" Then
TargetCol = i
Exit For
End If
Next i
If TargetCol = 0 Then
MsgBox "[ 名前 ]フィールドが見つかりません。", vbExclamation
Exit Sub
End If
''データの読み込み
For i = 2 To 10000 ''(1)
buf = ExecuteExcel4Macro(Target & "R" & i & "C" & TargetCol)
If buf = "0" Then Exit For ''(2)
''【アクティブシートに出力する】
ActiveSheet.Cells(i - 1, 1) = buf
''【配列に格納する】
ReDim Preserve GetNames(i - 1) ''(3)
GetNames(i - 1) = buf
Next i
''配列に格納したデータの確認
For i = 1 To UBound(GetNames)
Debug.Print GetNames(i)
Next i
End Sub