form1.frm

将xml格式的文件导入到 数据库中,将xml格式的文件导入到 数据库中

VERSION 5.00
Object = "{9ADF72AD-DDA9-11D1-9D4B-000021006D51}#1.23#0"; "UFSpGrid.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form 单据导入 
   Caption         =   "U870EAI单据导入(安洽专版)"
   ClientHeight    =   4005
   ClientLeft      =   1935
   ClientTop       =   4635
   ClientWidth     =   11955
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   7.064
   ScaleMode       =   7  'Centimeter
   ScaleWidth      =   21.087
   Begin MsSuperGrid.SuperGrid SuperGrid1 
      Height          =   2775
      Left            =   0
      TabIndex        =   4
      Top             =   720
      Width           =   11895
      _ExtentX        =   20981
      _ExtentY        =   4895
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      EditBorderStyle =   0
      Redraw          =   1
      HighLight       =   2
      GridColorFixed  =   -2147483632
      GridColor       =   -2147483633
      ForeColorSel    =   -2147483634
      ForeColorFixed  =   -2147483630
      BackColorSel    =   -2147483635
      BackColorFixed  =   -2147483633
      BackColorBkg    =   -2147483636
   End
   Begin VB.CommandButton Command4 
      Caption         =   "数据导入"
      Height          =   375
      Left            =   4020
      TabIndex        =   3
      Top             =   120
      Width           =   1575
   End
   Begin VB.CommandButton Command3 
      Caption         =   "关闭"
      Height          =   375
      Left            =   5580
      TabIndex        =   2
      Top             =   120
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "刷新"
      Height          =   375
      Left            =   2700
      TabIndex        =   1
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "保存配置"
      Height          =   375
      Left            =   1500
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   600
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "单据导入"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub refr()

Dim objs As Object
    Set objs = CreateObject("htinterface.inputcls")
    'Set objs = New U8Distribute.iDistribute
With SuperGrid1
Dim a, s As String
Dim str As String
Dim m, n As Integer
Dim FreeNum As Integer
FreeNum = FreeFile    'Freenum表示一个空闲的文件号
Open App.Path + "\mypatch.txt" For Input As FreeNum
n = 1

Do Until EOF(FreeNum) '循环，直到文件结尾。Eof函数用来判断文件是否读完
Line Input #FreeNum, str
str = objs.Decrypt(Trim(str), "a")
'str = Trim(str)
If n <= 7 Then

s = get_leftstr(str, ",")
'.TextMatrix(n, 0) = s


str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
'.TextMatrix(n, 1) = s

str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 2) = s

str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 3) = s


str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 4) = s

str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 5) = s

str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 6) = s

' m = m + 1
 
 n = n + 1
 End If
Loop
Close FreeNum
End With

Set objs = Nothing
End Sub
Private Sub refr1()
With SuperGrid1
Dim a, s As String
Dim str As String
Dim m, n As Integer
Dim FreeNum As Integer
FreeNum = FreeFile    'Freenum表示一个空闲的文件号
Open App.Path + "\mypatch.txt" For Input As FreeNum
''这步是打开“date.txt”，for input表示以输入方式（即读取文件）打开。如果要写入文件则应该用output或append。
m = 2
n = 1
Do Until EOF(FreeNum) '循环，直到文件结尾。Eof函数用来判断文件是否读完
'm = m + 1
Line Input #FreeNum, str
'str = UserCode(str)
If n <= 7 Then

s = get_leftstr(str, ",")
.TextMatrix(n, 0) = s


str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 1) = s

str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 2) = s

str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 3) = s


str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 4) = s

str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 5) = s

str = Right(str, Len(str) - (Len(s) + 1))
s = get_leftstr(str, ",")
.TextMatrix(n, 6) = s

 m = m + 1
 
 n = n + 1
 End If
Loop
Close FreeNum
End With


End Sub



Private Sub Command2_Click()
Call refr
End Sub

Private Sub Command4_Click()
Dim objs As Object
    Set objs = CreateObject("htinterface.inputcls")
'        objs.movedata SuperGrid1
        
        objs.movedata
        
 
        
        
    Set objs = Nothing
End Sub


Private Sub Form_Load()

'    '*********************************************************************************
'    '本控件 注册和未注册都无任何使用限制，可免费使用
'    '只是未注册用户，使用以前要加上以下版权声明，否则不能正常使用
'    '.TrayPoweredBy = "本控件由绿兔社区-VB版块提供 http://www.tubr.com/club QQ:6487911"
'    '本控件注册后，可去除以下版权声明，注册费用10元。不注册在加了以下一行版权声明后一样可以正常使用
'    '**********************************************************************************
'    Me.TubrTray1.TrayPoweredBy = "本控件由绿兔社区-VB版块提供 http://www.tubr.com/club QQ:6487911"
'    '**********************************************************************************