|
请问这个路径怎么改?
老师你好!
我想请教:
这个是我依照你的资料进行了更改:
现在的可以修改后数据库存在本机上可以进行修改存储。
我想问一下:
1.EXCEL表放在本机。
2.数据库放在局域中共享电脑的一个资料夹里。
路径为:
\\pmc\palan\GP.MDB 密码 hfq
请问这个路径怎么更改?
Public Sub 修改或新增()
'以识别码为准决定是修改或新增
Dim GP As String, myTable As String
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Long, j As Long
Dim myCat As New ADOX.Catalog
Dim myCmd As ADODB.Command
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Set wb = ThisWorkbook
Set ws = wb.Sheets("PLAN") 'EXCEL工作表名称 PLAN
GP = wb.Path & "\GP.mdb" '数据为名称
myTable = "GP" '数据库工作表名称
If Dir(GP) = "" Then
myCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & GP
Set cnn = myCat.ActiveConnection
Set myCmd = New ADODB.Command
Set myCmd.ActiveConnection = cnn
myCmd.CommandText = "CREATE TABLE " & GP _
& "(周别 Text(50),客户 text(50),课别 text(50),销售合同 Text(50),产品名称 Text(50),半成品名称 Text(50),取数 Single,准备工时 Single,标准工时 Single,标准产能 Single,交货量 Single,计划量 Single,延误描述 Text(50),延误现象 Text(50),延误次数 Text(50))," _
& "(交货日期 date,总工时 Single,实绩完成 Single,计划达成 percent,备注 text(50),时间 date(50),电脑 text(50),用户 text(50)),"
myCmd.Execute , , adCmdText
Else
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open GP
End With
Set rs = cnn.OpenSchema(adSchemaTables)
Do Until rs.EOF
If LCase(rs!table_name) = LCase(myTable) Then GoTo hhh
rs.MoveNext
Loop
Set myCmd = New ADODB.Command
Set myCmd.ActiveConnection = cnn
myCmd.CommandText = "CREATE TABLE " & GP _
& "(周别 Text(50),客户 text(50),课别 text(50),销售合同 Text(50),产品名称 Text(50),半成品名称 Text(50),取数 Single,准备工时 Single,标准工时 Single,标准产能 Single,交货量 Single,延误描述 Text(50),延误现象 Text(50),计划量 Single,延误次数 Text(50))," _
& "(交货日期 date,总工时 Single,实绩完成 Single,计划达成 percent,备注 text(50),时间 date(50),电脑 text(50),用户 text(50)),"
myCmd.Execute , , adCmdText
hhh:
End If
n = ws.Range("A65536").End(xlUp).Row
For i = 7 To n '第7行开始
If ws.Cells(i, 24).Value <> "" Then
Sql = "select * from GP where 识别码=" & ws.Cells(i, 24).Value
Else
Sql = "select * from GP"
End If
Set rs = New ADODB.Recordset
rs.Open Sql, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount = 0 Or ws.Cells(i, 24).Value = "" Then
rs.AddNew
For j = 1 To rs.Fields.Count - 1
rs.Fields(j - 1) = ws.Cells(i, j).Value
Next j
rs.Update
Else
For j = 1 To rs.Fields.Count - 1
rs.Fields(j - 1) = ws.Cells(i, j).Value
Next j
rs.Update
End If
Next i
MsgBox "^-^ 存储成功! ^-^", vbInformation, "系统提示! "
rs.Close
cnn.Close
Set wb = Nothing
Set ws = Nothing
Set rs = Nothing
Set myCmd = Nothing
Set myCat = Nothing
Set cnn = Nothing
End Sub
[ 本帖最后由 samuel-he 于 2011-6-29 17:08 编辑 ] |
|