VBAでループ中にエラー処理する
やりたいこと
テキストファイルを開こうとしたときに、ファイルがなければ別のパスを設定して
再試行する処理を作りたい。
コード
thisworkbook.vb
' ワークブックを開く時のイベント
Private Sub Workbook_Open()
Dim path As String
Dim filename As String
path = "C:\Users\【username】\Desktop\test\test1\"
filename = "新しいテキスト ドキュメント.txt"
path = path_check(path, filename)
If path = "" Then
MsgBox "patherror"
Exit Sub
End If
filepath = path + filename
n = FreeFile
Open filepath For Input As #n
Do While Not EOF(n)
i = i + 1
Line Input #n, txtLine
Cells(i, 1).Value = txtLine
Loop
Close #n
End Sub
module1.vb
Option Explicit
Public Function path_check(path, filename)
Dim i As Integer
Dim pathflg As Integer
Dim open_result As Boolean
Dim FSO As Object
Dim TextFile As Object
pathflg = 0
For i = 0 To 3
open_result = True
On Error GoTo ErrLabel
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TextFile = FSO.OpenTextFile(path + filename)
If open_result = True Then
GoTo success
End If
Next i
ErrLabel:
open_result = False
Select Case pathflg
Case 0
path = "C:\Users\【username】\Desktop\test\test2\"
Case 1
path = "C:\Users\【username】\Desktop\test\test3\"
Case 2
path = ""
Case Else
path_check = ""
End Select
pathflg = pathflg + 1
Resume Next
success:
path_check = path
End Function
thisworkbook.vb
' ワークブックを開く時のイベント
Private Sub Workbook_Open()
Dim path As String
Dim filename As String
path = "C:\Users\【username】\Desktop\test\test1\"
filename = "新しいテキスト ドキュメント.txt"
path = path_check(path, filename)
If path = "" Then
MsgBox "patherror"
Exit Sub
End If
filepath = path + filename
n = FreeFile
Open filepath For Input As #n
Do While Not EOF(n)
i = i + 1
Line Input #n, txtLine
Cells(i, 1).Value = txtLine
Loop
Close #n
End Sub
module1.vb
Option Explicit
Public Function path_check(path, filename)
Dim i As Integer
Dim pathflg As Integer
Dim open_result As Boolean
Dim FSO As Object
Dim TextFile As Object
pathflg = 0
For i = 0 To 3
open_result = True
On Error GoTo ErrLabel
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TextFile = FSO.OpenTextFile(path + filename)
If open_result = True Then
GoTo success
End If
Next i
ErrLabel:
open_result = False
Select Case pathflg
Case 0
path = "C:\Users\【username】\Desktop\test\test2\"
Case 1
path = "C:\Users\【username】\Desktop\test\test3\"
Case 2
path = ""
Case Else
path_check = ""
End Select
pathflg = pathflg + 1
Resume Next
success:
path_check = path
End Function
Author And Source
この問題について(VBAでループ中にエラー処理する), 我々は、より多くの情報をここで見つけました https://qiita.com/nunnunnununun/items/e472941ed033cd983ff0著者帰属:元の著者の情報は、元のURLに含まれています。著作権は原作者に属する。
Content is automatically searched and collected through network algorithms . If there is a violation . Please contact us . We will adjust (correct author information ,or delete content ) as soon as possible .