| 投稿日 | ： 2003/11/03(Mon) 11:08 |
| 投稿者 | ： 花ちゃん |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^4: 既存のExcelファイルにアクセスするには |
今までのコードは破棄して、下記のコードをペーストして下さい。
それで動作を確認後に変更するなり、削除するなりして下さい。
（前回の回答で指摘している部分が改善されていないので）
Option Explicit
Private Sub Command1_Click()
Dim Fso As New FileSystemObject
With List1
.Clear
.Visible = False
End With
Call sFolderSearch(Fso.GetFolder("C:\WINDOWS\デスクトップ\顧客管理"))
'自フォルダーを含める場合
List1.AddItem "C:\Documents and Settings\YPCS_NO1\My Documents"
List1.Visible = True
End Sub
Private Sub sFolderSearch(ByRef myFolder As Folder)
Dim mySubFolder As Folder
With myFolder
If .SubFolders.Count > 0 Then
For Each mySubFolder In .SubFolders
List1.AddItem mySubFolder
Call sFolderSearch(mySubFolder)
Next
End If
End With
End Sub
Private Sub Command2_Click()
If MsgBox("終了しますか？", vbQuestion + vbYesNo, "終了") = vbNo Then
text2.SetFocus
Else
Unload Me
End If
End Sub
Private Sub Command3_Click()
'思い通りの操作ができるまで下記のエラー処理は実行しない事
' On Error Resume Next
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlFileName As String
xlFileName = List1 & "\" & File1.FileName
'ファイルが見つからない場合
If Len(Dir$(xlFileName)) = 0 Then Exit Sub
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(xlFileName)
Set xlSheet = xlBook.Worksheets(1)
xlApp.Visible = True
'終了処理
' xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Private Sub Form_Load()
'存在しない拡張子を指定
File1.Pattern = "abcde"
End Sub
Private Sub List1_Click()
'表示したいファイルの拡張子を指定
File1.Pattern = "*.XLS;*.CSV"
File1.Path = List1
End Sub