📄 frmimport.frm
字号:
Left = 4320
TabIndex = 7
Top = 350
Width = 855
End
Begin VB.TextBox txtOther
Height = 285
Left = 5400
TabIndex = 8
Top = 320
Width = 1050
End
End
Begin VB.CheckBox chkFirstRow
Caption = "第一列作为字段名称(&F)"
Height = 255
Left = 120
TabIndex = 9
Top = 1870
Width = 3135
End
Begin VB.ComboBox cboQualifier
Height = 300
Left = 5760
TabIndex = 10
Text = "cboQualifier"
Top = 1800
Width = 855
End
Begin VB.Frame fraOptions
Caption = "字段属性"
Height = 735
Left = 120
TabIndex = 21
Top = 2760
Width = 6615
Begin VB.ComboBox cmbfield
Height = 300
Left = 600
TabIndex = 39
Text = "Combo1"
Top = 280
Width = 1575
End
Begin VB.ComboBox cboType
Height = 315
Left = 4560
TabIndex = 12
Top = 280
Width = 1695
End
Begin VB.TextBox txtField
Height = 285
Left = 2520
TabIndex = 11
Top = 280
Visible = 0 'False
Width = 930
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "名称："
Height = 180
Index = 0
Left = 120
TabIndex = 23
Top = 315
Width = 450
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "数据类型："
Height = 195
Index = 1
Left = 3600
TabIndex = 22
Top = 315
Width = 795
End
End
Begin MSFlexGridLib.MSFlexGrid flxPreview
Height = 1845
Left = 120
TabIndex = 13
Top = 3600
Width = 6645
_ExtentX = 11721
_ExtentY = 3254
_Version = 393216
ForeColorFixed = -2147483640
BackColorSel = 12582912
BackColorBkg = -2147483644
GridColor = -2147483640
GridColorFixed = -2147483640
BorderStyle = 0
Appearance = 0
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "替换限定词(&Q)："
Height = 195
Left = 4200
TabIndex = 26
Top = 1920
Width = 1290
End
Begin VB.Label Label2
Caption = $"FrmImport.frx":5AF0C
Height = 375
Index = 1
Left = 120
TabIndex = 25
Top = 2280
Width = 6735
End
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 1
X1 = 0
X2 = 7080
Y1 = 5655
Y2 = 5655
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 0
X1 = 0
X2 = 6960
Y1 = 5640
Y2 = 5640
End
End
Attribute VB_Name = "FrmImportNode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************
'*
'* 本源码完全免费，共交通同仁学习参考 *
'* www.tranbbs.com *
'* Developed by Yang Ming *
'* Nanjing Institute of City Transportation Planning *
'* 请保留本版权信息，谢谢合作 *
'* 中国交通技术论坛 *
'* *
'* *
'*********************************************************************
Private aryNameAndType As Variant
Private aryFields As Variant
Private intIndex As Integer
Private intStep As Integer
Private ASCIIFileName As String
Private AccessFileName As String
Private AccessTableName As String
Private Edited As Boolean
Private strDelimiter As String
Private Complete As Boolean
Private Sub ImportASCII()
Dim dbMain As Database
Dim rsMain As Recordset
Dim intFound As Integer
Dim strLine As String
Dim intLoop As Integer
Dim strFields As String
Dim lngFileLen As Long
Dim lngProgress As Long
'Validate
picWizard(3).MousePointer = vbHourglass
If Dir(AccessFileName) = "" Or AccessFileName = "" Or ASCIIFileName = "" Or Dir(ASCIIFileName) = "" Then
Err.Raise 100, "Import", "Bad File Name"
End If
lngFileLen = FileLen(ASCIIFileName)
lngProgress = lngFileLen / 100
Set dbMain = OpenDatabase(AccessFileName)
On Error Resume Next
dbMain.Execute "DROP TABLE " & AccessTableName & ";"
On Error GoTo ErrHndl
'Compile field information
strFields = ""
For intLoop = 1 To UBound(aryNameAndType)
strFields = strFields & aryNameAndType(intLoop, 1) & " " & aryNameAndType(intLoop, 2) & ", "
Next intLoop
strFields = Mid(strFields, 1, Len(strFields) - 2)
strFields = Replace(strFields, "AUTONUMBER", "COUNTER")
dbMain.Execute "CREATE TABLE " & AccessTableName & "(" & strFields & ");"
'Now import the text file into the new database
Set rsMain = dbMain.OpenRecordset(AccessTableName)
Open ASCIIFileName For Input As #1
'Remove first row if it contains field names
If chkFirstRow.Value = 1 Then
Line Input #1, strLine
End If
On Error Resume Next
Do While Not EOF(1)
Line Input #1, strLine
'Remove text qualifiers
If InStr(strLine, cboQualifier.Text) <> 0 Then strLine = Replace(strLine, cboQualifier.Text, "")
lngBytes = lngBytes + Len(strLine)
rsMain.AddNew
For intLoop = 1 To Len(strLine)
intFound = InStr(strLine, strDelimiter)
If intFound = 0 Then
rsMain.Fields(intLoop - 1).Value = Trim$(strLine)
Exit For
End If
rsMain.Fields(intLoop - 1).Value = Trim$(Mid(strLine, 1, intFound - 1))
strLine = Mid(strLine, intFound + 1)
Next intLoop
rsMain.Update
DoEvents
'update progress
lblPercent = Abs(CInt((lngBytes / lngFileLen) * 100 - 1)) & "% Complete"
Loop
Close #1
DoEvents
dbMain.Close
picWizard(3).MousePointer = vbNormal
lblPercent = "100% Complete"
tmrUnload.Enabled = True
Exit Sub
ErrHndl:
Close
picWizard(3).MousePointer = vbNormal
cmdnext.Enabled = True
cmdPrevious.Enabled = True
cmdFinish.Enabled = False
picWizard(intStep).Visible = False
intStep = 2
picWizard(intStep).Visible = True
MsgBox Err.Description, vbInformation, "Error:"
End Sub
Private Function PreviewASCII(Delimiter As String)
Dim intFound As Integer
Dim intLoop As Integer
Dim intRows As Integer
Dim intStart As Integer
Dim strLine As String
Dim strGrid As String
ReDim aryFields(0)
ReDim aryNameAndType(0, 1 To 2)
strDelimiter = Delimiter
flxPreview.Clear
flxPreview.Cols = 0
flxPreview.Rows = 1
FileName = ASCIIFileName
On Error GoTo ErrHndl
'Validate again
If Dir(FileName) = "" Or FileName = "" Then
ASCIIFileName = ""
txtFrom = ""
picWizard(intStep).Visible = False
intStep = 1
picWizard(intStep).Visible = True
MsgBox "Bad file name!", vbInformation, "Error:"
Exit Function
End If
'Remove junk from tablename
'First, see how many fields there are
Open FileName For Input As #1
Line Input #1, strLine
Close #1
For intLoop = 1 To Len(strLine)
intFound = InStr(strLine, Delimiter)
If intFound = 0 Then
ReDim Preserve aryFields(1 To UBound(aryFields) + 1)
aryFields(intLoop) = Trim$(strLine)
Exit For
End If
ReDim Preserve aryFields(1 To UBound(aryFields) + 1)
aryFields(intLoop) = Trim$(Mid(strLine, 1, intFound - 1))
strLine = Mid(strLine, intFound + 1)
Next intLoop
ReDim aryNameAndType(1 To UBound(aryFields), 1 To 2)
For intLoop = 1 To UBound(aryFields)
If chkFirstRow.Value = 1 Then
aryNameAndType(intLoop, 1) = aryFields(intLoop)
Else
aryNameAndType(intLoop, 1) = "Field" & intLoop
End If
aryNameAndType(intLoop, 2) = "TEXT"
Next intLoop
'Add the columns
For intLoop = 1 To UBound(aryFields)
flxPreview.Cols = flxPreview.Cols + 1
flxPreview.Col = intLoop - 1
flxPreview.Row = 0
flxPreview.Text = aryFields(intLoop)
Next intLoop
'Fill the grid with about 7 rows of data
Open FileName For Input As #1
intRows = 1
flxPreview.Rows = 2
Do While Not EOF(1)
Line Input #1, strLine
'Insert this row into the grid
For intLoop = 1 To UBound(aryFields)
intFound = InStr(strLine, Delimiter)
If intFound = 0 Then
strGrid = Trim$(strLine)
Else
strGrid = Trim$(Mid(strLine, 1, intFound - 1))
strLine = Trim$(Mid(strLine, intFound + 1))
End If
'Insert strGrid
flxPreview.Col = intLoop - 1
flxPreview.Row = intRows
flxPreview.Text = strGrid
Next intLoop
intLoop = intLoop + 1
If intRows = 7 Then Exit Do
intRows = intRows + 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -