Sub text読込()
' excel お宝ﾍﾙﾌﾟより ----------------------------------------＜参考までに＞-----------
Dim MyName As String, OpenName As String
Dim FieldInfo1(256)
Dim Message As String, Title As String
Dim txtfield As String, myArray() As String
Dim n As Integer, i As Integer
MyName = Application.GetOpenFilename _
("ﾃｷｽﾄ ﾌｧｲﾙ (*.txt;*.csv), *.txt;*.csv")
If MyName = "False" Then Exit Sub
If UCase(Right(MyName, 3)) = "CSV" Then
OpenName = Left(MyName, Len(MyName) - 3) & "txt"
Name MyName As OpenName
Else
OpenName = MyName
End If
Message = "文字列データの位置を「,」で区切って指定して下さい。" _
& Chr(13) & " 例 ： 3,5,8,13" & Chr(13) _
& "指定無しの場合、全フィールドを文字列とします。"
Title = "文字列フィールド設定"
txtfield = InputBox(Message, Title)
If txtfield = "" Then
For i = 1 To 256
FieldInfo1(i) = Array(i, 2)
Next
Else
For i = 1 To 256
FieldInfo1(i) = Array(i, 1)
Next
n = strCount(txtfield, ",") + 1
ReDim myArray(n)
For i = 1 To n
If InStr(txtfield, ",") > 0 Then
myArray(i) = Left(txtfield, InStr(txtfield, ",") - 1)
txtfield = Mid(txtfield, InStr(txtfield, ",") + 1, _
Len(txtfield))
Else
myArray(i) = txtfield
End If
FieldInfo1(Val(myArray(i))) = Array(Val(myArray(i)), 2)
Next i
End If
Workbooks.OpenText FileName:=OpenName, StartRow:=1, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
Comma:=True, FieldInfo:=FieldInfo1
End Sub
Sub text読込2() ' 全列を文字列で開く。
Dim MyName As String, OpenName As String
Dim FieldInfo1(256)
Dim Message As String, Title As String
Dim txtfield As String, myArray() As String
Dim n As Integer, i As Integer
OpenName = "d:\si\sql_db_out.cs"
For i = 1 To 256
FieldInfo1(i) = Array(i, 2)
Next
n = strCount(txtfield, ",") + 1
ReDim myArray(n)
For i = 1 To n
If InStr(txtfield, ",") > 0 Then
myArray(i) = Left(txtfield, InStr(txtfield, ",") - 1)
txtfield = Mid(txtfield, InStr(txtfield, ",") + 1, _
Len(txtfield))
Else
myArray(i) = txtfield
End If
FieldInfo1(Val(myArray(i))) = Array(Val(myArray(i)), 2)
Next i
Workbooks.OpenText FileName:=OpenName, StartRow:=1, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
Comma:=True, FieldInfo:=FieldInfo1
End Sub
Function strCount(tmp As String, str As String)
Dim pos As Integer, cnt As Integer, buf As String
buf = tmp
pos = InStr(buf, str)
Do While pos > 0
cnt = cnt + 1
buf = Mid(buf, pos + 1, Len(buf))
pos = InStr(buf, str)
Loop
strCount = cnt
End Function