Office中国论坛/Access中国论坛

标题: 如何更新数据而不是替换. [打印本页]

作者: sbsfhgl 时间: 2008-7-6 21:40
标题: 如何更新数据而不是替换.
请问如何将这段代码,改成直接更新数据("D:\myBB\XLS\员工名单.XLS)而不是替换.对了这是海狸先生的代码
我的想法是,EXCEL一张工作薄里有三张表,把一张表A数据格式设好,数据来源里外一个表B,采用子窗体导出数据导入到EXCEL中的一张表B,这样少了很多事.因为ACCESS设置报表有点麻烦.但是采用以上方法呢,他是把EXCEL文件都替换掉了,我原来设计的格式就没起到作用.故..................
如何更新数据而不是替换.

附件已上传在11楼

Private Sub 命令5_Click()
On Error GoTo errit
Dim oExcel As Object
Dim oBook As Object
Dim i As Integer
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add()
Me.子对象2.Form.Recordset.MoveFirst
For i = 0 To Me.子对象2.Form.Recordset.Fields.count - 1
oBook.Worksheets(1).Cells(1, i + 1).Value = Me.子对象2.Form.Recordset.Fields(i).name
Next
oBook.Worksheets(1).Range("A2").CopyFromRecordset Me.子对象2.Form.Recordset
oBook.SaveAs ("D:\myBB\XLS\员工名单.XLS")
MsgBox "导出成功"
errexit: oBook.Close False
oExcel.quit
Set oBook = Nothing
Set oExcel = Nothing
Exit Sub
errit:
MsgBox "错误号为" & err.Number & " 错误说明：" & err.Description
Resume errexit

End Sub

[ 本帖最后由 sbsfhgl 于 2008-7-8 20:50 编辑 ]

作者: ganrong 时间: 2008-7-7 09:44
提示: 作者被禁止或删除内容自动屏蔽

作者: sbsfhgl 时间: 2008-7-7 12:32
不得行呀,提示内容:
1.错误号为449,错误说明:参数不可选
2.错误号为91,错误说明:对象变量或WITH块变量未设置

作者: ui 时间: 2008-7-7 12:59
oExcel.Workbooks.Open 里需要多个参数
可按F1查excel帮助,至少有个文件名的参数

作者: sbsfhgl 时间: 2008-7-7 18:39
查excel帮助?

作者: sbsfhgl 时间: 2008-7-7 20:30
不晓得怎么弄,各位帮我想想办法/?

作者: beenet 时间: 2008-7-7 21:03
我程序中有部分写EXCEL的看看能否有帮助写得比较乱

  Dim Str, Fname, Ftb, Ftb1, Enr As String
Dim TM, SS As Long
Dim oApp As Object
Dim oappwork As Excel.Workbook, oappwork_sub As Excel.Worksheet
Dim n1, n2 As String
Dim conn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim i, ii, iii, No As Integer
Dim SHR, XSFR, MDD As String
Dim SL, Rn As Integer
Dim Eii, EFR As Boolean

TM = Timer

Fname = CurrentProject.Path & "\DSTR.xls"

Set oApp = CreateObject("Excel.Application")
' oApp.Visible = True
oApp.Visible = False

Set oappwork = oApp.Workbooks.Open(Fname)
oApp.DisplayAlerts = False

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Ftb = "物量分析表"
i = oappwork.Sheets(Ftb).UsedRange.Rows.Count

Set conn = CurrentProject.Connection
Str = "SELECT IIf(IsNull([T_RI]![销售法人]),'OTHER',[T_RI]![销售法人]) AS 销售法人, T_RI.收货人, Sum(T_PI.数量) AS 数量, T_CI.目的地 FROM (T_RI LEFT JOIN T_PI ON T_RI.发票号码 = T_PI.发票号码) LEFT JOIN T_CI ON T_RI.收货人 = T_CI.收货人 GROUP BY IIf(IsNull([T_RI]![销售法人]),'OTHER',[T_RI]![销售法人]), T_RI.收货人, T_CI.目的地 ORDER BY IIf(IsNull([T_RI]![销售法人]),'OTHER',[T_RI]![销售法人]) DESC , T_RI.收货人;"
rst.Open Str, conn, adOpenKeyset, adLockOptimistic
Rn = CInt(Format(Date, "m")) * 2 + 3
SS = DSum("数量", "T_PI")
oappwork.Sheets(Ftb).Cells(6, Rn) = SS
If rst.RecordCount <> 0 Then
      rst.MoveFirst
      Do While Not rst.EOF
         SHR = Trim(rst.Fields("收货人"))
         SL = Trim(rst.Fields("数量"))
         XSFR = Trim(rst.Fields("销售法人"))
         MDD = Trim(IIf(IsNull(rst.Fields("目的地")), "", rst.Fields("目的地")))
         If XSFR <> "OTHER" Then
            For ii = 7 To i
                  If SHR = oappwork.Sheets(Ftb).Range("B" & ii) Then
                     oappwork.Sheets(Ftb).Cells(ii, Rn) = SL
                     oappwork.Sheets(Ftb).Cells(ii, Rn + 1) = SL / SS
                     Exit For
                  ElseIf ii = i And SHR <> oappwork.Sheets(Ftb).Range("B" & ii) Then
                     For iii = 7 To i
                        If XSFR = oappwork.Sheets(Ftb).Range("A" & iii) And oappwork.Sheets(Ftb).Range("B" & iii) = "Sub total" Then

                              oappwork.Sheets(Ftb).Rows(iii - 1 & ":" & iii - 1).Insert Shift:=xlDown

                              oappwork.Sheets(Ftb).Cells(iii - 1, 2) = SHR
                              oappwork.Sheets(Ftb).Cells(iii - 1, 3) = MDD
                              oappwork.Sheets(Ftb).Cells(iii - 1, Rn) = SL
                              oappwork.Sheets(Ftb).Cells(ii, Rn + 1) = SL / SS
                              i = oappwork.Sheets(Ftb).UsedRange.Rows.Count
                              Exit For
                        End If
                     Next iii
                  End If
            Next ii
         Else
            oappwork.Sheets(Ftb).Cells(i + 1, 1) = XSFR
            oappwork.Sheets(Ftb).Cells(i + 1, 2) = SHR
            oappwork.Sheets(Ftb).Cells(i + 1, 3) = MDD
            oappwork.Sheets(Ftb).Cells(i + 1, Rn) = SL
            oappwork.Sheets(Ftb).Cells(ii, Rn + 1) = SL / SS

            i = oappwork.Sheets(Ftb).UsedRange.Rows.Count
         End If
         rst.MoveNext
      Loop
End If

oappwork.Close savechanges:=True
Set oappwork = Nothing
oApp.DisplayAlerts = True

MsgBox "文件生成成功，存放于" & vbNewLine & Fname & vbNewLine & "耗时 " & Format(Timer - TM, "0.000") & " 秒", 64, "提示"

oApp.Visible = True
Set oappwork = oApp.Workbooks.Open(Fname)
oApp.UserControl = False

作者: sbsfhgl 时间: 2008-7-7 22:02
没有呀

作者: sbsfhgl 时间: 2008-7-8 10:49
还是不知道怎么做,要把文件更改了,我的想法是,我在一张工作薄里有三张表里,把一张表数据格式设好,数据来源里外一个表,这样少了很多事.但是这种方法把工作文件都替换掉了..................

作者: sbsfhgl 时间: 2008-7-8 18:16
..................

作者: sbsfhgl 时间: 2008-7-8 20:49
我的想法是,EXCEL一张工作薄里有三张表,把一张表A数据格式设好,数据来源里外一个表B,采用子窗体导出数据导入到EXCEL中的一张表B,这样少了很多事.因为ACCESS设置报表有点麻烦.但是采用以上方法呢,他是把EXCEL文件都替换掉了,我原来设计的格式就没起到作用.故..................
如何更新数据而不是替换.

附件已上传

作者: sbsfhgl 时间: 2008-7-9 09:34
顶一下.....................

作者: andymark 时间: 2008-7-9 10:19
晕死, 上传例子不上传EXCEL
别人怎么知道你要替换什么内容

作者: sbsfhgl 时间: 2008-7-9 10:50

原帖由 andymark 于 2008-7-9 10:19 发表
晕死, 上传例子不上传EXCEL
别人怎么知道你要替换什么内容

版主,已上传模板.关于这个还有一个问题
EXCEL中能不能设置自动更新数据,即EXCEL表-入库模板,自动识别表Sheet1里的数据,=Sheet1!A2,,=Sheet1!A3......,而且是自动增长,现在我全部是手工操作引用.

但关键是,如何时自动将导出的数据自动更新到-入库表!Sheet1

作者: sbsfhgl 时间: 2008-7-9 22:55
............

作者: andymark 时间: 2008-7-9 23:31
首先要判断EXCEL表中的SHEET最大行号
定位第一条记录, 用记录集循环写进,保存退出

Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(CurrentProject.Path & "\ExcelFile\" & StrFileName)

Set wks = appExcel.Worksheets("Sheet1")

Y = 5

Sql = "SELECT * FROM LCDHealthQuery ORDER BY Technology"

Rs.Open Sql, Conn, adOpenKeyset, adLockOptimistic
K = Rs.Fields.Count + 2

For J = 1 To Rs.Fields.Count - 1
   wks.Cells(Y, J + 2).Value = Rs.Fields(J).Name

Next

For J = 1 To Rs.Fields.Count - 1
   If Left(Rs.Fields(J).Name, 2) = "WK" Then
      If Rsc.Fields(J).Name >= Me.CmdStarWeek Then
         StrYear = Me.CmbStarYear
         Else
         StrYear = Me.CmbStarYear + 1
      End If
   wks.Cells(Y + 1, J + 2).Value = DLookup("WeekStar", "", "PlanYear='" & StrYear & "' and WeekName='" & Rsc.Fields(J).Name & "'")

   Else
   wks.Cells(Y + 1, J + 2).Value = Rs.Fields(J).Name

   End If

Next


Rs.MoveFirst

Y = 7

.....后面自已写

作者: andymark 时间: 2008-7-9 23:31
直接用上面的语句是不行的, 上面只是列举方法

作者: andymark 时间: 2008-7-9 23:32
必须打开EXCEL的SHEET表,读取总行数
才能进行上面的操作

作者: sbsfhgl 时间: 2008-7-10 08:16
有没有例程呀。。。

作者: stevenyang 时间: 2008-7-10 09:54
dgood

作者: sbsfhgl 时间: 2008-7-10 12:33
...........

作者: huangxiuwen 时间: 2008-7-10 13:49
[:24] [:24]

作者: sbsfhgl 时间: 2008-7-10 16:54
自己已解决好了，不过仍谢谢各位

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)