VBAでユーザーフォーム上に参照したファイルを開きたいのですが…

Question

EXCEL2003 SP3での質問です。
ユーザーフォームをVBAで作成中です。
主な機能は、対象月をコンボBOXで選択させた上で、
データ元とインプット先のファイルをテキストBOXに参照し、
実行ボタンクリックでデータ元からインプット先の該当月シートに
データをコピーするといった感じです。
（データ元の該当シート内データを全てコピー＆ペースト）
取り込み以降の処理はVBAを使用せずに作成しようと考えています。

質問は、取込みたいファイルの参照後の「ファイルを開いてデータをコピーする」処理がうまくいかず、
どのようにしたらよいか教えて頂けますでしょうか。

現在、以下のように記述していますが、
CommandButton3_Click()の部分の処理が分からずファイルが開けません。ご教授ください。


Private Sub CommandButton1_Click()
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "テキスト", "*.csv;*.txt", 1
    If .Show = 0 Then Exit Sub
        Me.TextBox1.Text = .SelectedItems(1) 
    End With
End Sub

Private Sub CommandButton2_Click()
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "テキスト", "*.csv;*.txt", 1
    If .Show = 0 Then Exit Sub
        Me.TextBox2.Text = .SelectedItems(1) 
    End With
End Sub

Private Sub CommandButton3_Click()
    Dim file_name As String
    If TextBox1.Text = "" Then
        MsgBox "ファイルが指定されていません", vbInformation
    ElseIf TextBox1.Text = "" Then
    file_name = TextBox1.Text = ""
    Shell "Workbooks.OpenText TextBox1.Value " 
    End If
End Sub

Private Sub CommandButton4_Click()
    yesno = MsgBox("保存後、ファイルを閉じます。終了していいですか？", vbYesNo + vbQuestion, "Reportの終了")
    
    If yesno = vbYes Then
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Else
    End If
End Sub

Wendy02 · Accepted Answer

こんばんは。

モジュールレベルの変数をモジュールの一番上に置き、CommandButton3_Clickの中のfile_name 変数の宣言を削除します


ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Range("A1")

インプット先の該当月シートは、
ここの、ActiveSheet の部分を、
ThisWorkbook.Worksheets(shname).Range("A1")
などとして、shname を、別なところで指定してあげる方法があります。

'-------------------------------------
'Option Explicit
Dim file_name

'-----
'省略
'----

Private Sub CommandButton3_Click()
　　If TextBox1.Text = "" Then
　　　　MsgBox "ファイルが指定されていません", vbInformation
　　Else
　　　　file_name = TextBox1.Text
　　　　Workbooks.OpenText file_name
　　　　'シートへのコピー
　　　　ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Range("A1")
　　End If
End Sub

Private Sub CommandButton4_Click()
　　Dim yesno As VbMsgBoxResult
　　Dim fn As String
　　'モジュールレベル変数のチェック
　　If file_name <> "" Then
　　　　fn = Mid$(file_name, InStrRev(file_name, "\") + 1)
　　　　yesno = MsgBox("保存後、ファイルを閉じます。終了していいですか？", _
　　　　vbYesNo + vbQuestion, "Reportの終了")
　　　　If yesno = vbYes Then
　　　　　　On Error Resume Next
　　　　　　'テキストボックスを保存して閉じる
　　　　　　'UserForm上から、ThisWorkbook.Close は、ファイル・トラブルの元ですから、そのまま、終了はしてはいけません。
　　　　　　Workbooks(fn).Close True
　　　　　　On Error Goto 0
　　　　　　file_name = ""
　　　　End If
　　End If
End Sub

Wendy02 · Answer

こんばんは。 >今後、データの置換など細かな設定を行っていきます。まだ、最終ではありませんよね。 TextBox1 で開け、もうひとつ、TextBox2 も開けて、それを順次、コピーしていくのでしょうか。 Workbooks.OpenText TextBox2.Value 'Excelで開く ' この下の部分も、TextBox1 のところと同じように働くわけですか？とはいえ、難しいことしていますね。(^^ゞそこで、考え方は違うかもしれませんが、例えば、今の状態だと、何かいきなりという感じで、マクロが進んでしまうような気がします。ListBox の選択をうっかり忘れていることなんてありませんか。ボタンを押したら、あっという間に、コピーされてしまいます。ファイル名がテキストボックスに入って、リストボックスが選択されたのを確認したら、後は、一気に、「同じシート」にインポートというようにします。いくつか、テクニックが入っていますから、解説があるので、何か折に利用してみてください。 --------------------------------------- Private Sub CommandButton3_Click() 　　Dim mon As Variant 　　Dim i As Integer 　　Dim j As Integer 　　Dim iflg As Variant 　　Dim file_name As String 　　Dim n As Long 　　Dim rng As Range 　　For i = 1 To 2　'Controls でループ　　　　If Me.Controls("TextBox" & i).Text <> "" Then 　　　　　　iflg = 1 + iflg 　　　　End If 　　Next i 　　If iflg < 2 Then 'テキストボックスの数　　　　MsgBox "TextBox 両方にファイル名を入れてください。" 　　　　Exit Sub 　　End If 　　'リストボックスが選択されているかチェック　　If Me.ListBox1.ListIndex > -1 Then 　　　　Application.Goto ThisWorkbook.Worksheets(Me.ListBox1.Value).Range("A1") 'ブックをActivate せずにJump 　　　　If MsgBox(Me.ListBox1.Value & " のシートでよろしいですか?", vbQuestion + vbOKCancel) = vbCancel Then 　　　　　　Exit Sub 　　　　End If 　　Else 　　　　MsgBox "ListBox を選択してください。", vbInformation 　　　　Exit Sub 　　End If 　　'テキストボックスのファイル名をひとつずつ処理　　For j = 1 To 2 　　　　file_name = Me.Controls("TextBox" & j).Text 　　　　With ThisWorkbook.Worksheets(Me.ListBox1.Value) 　　　　　　If rng Is Nothing Then 　　　　　　　　Set rng = .Range("A1") 　　　　　　Else 　　　　　　　 '二度目に開いたときの最終行を探す　　　　　　　　With ActiveSheet.UsedRange 　　　　　　　　　　n = .Cells(.Cells.Count).Row 　　　　　　　　　　Set rng = .Cells(n + 1, 1) 　　　　　　　　End With 　　　　　　End If 　　　　End With 　　　　On Error Resume Next 　　　　Workbooks.OpenText file_name 　　　　'選択したシートに貼り付け　　　　With ActiveWorkbook 　　　　　　.ActiveSheet.UsedRange.Copy rng 　　　　　　.Close False 'テキストファイルは保存せずに終わる　　　　End With 　　Next j 　　On Error Goto 0 　　Application.Goto ThisWorkbook.Worksheets(Me.ListBox1.Value).Range("A1") 　　Set rng = Nothing End Sub

VBAでユーザーフォーム上に参照したファイルを開きたいのですが…

こんばんは。

こんばんは。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング