从Access写入Excel中的命名单元格

时间:2017-06-15 19:41:30

标签: vba excel-vba access-vba excel

我在这里搜索了论坛,但我似乎无法使用此代码。

我正在尝试在Excel中打开一个工作簿,然后填充一些单元格(命名范围)。我可以成功打开工作簿(工作簿有一些VBA在打开时运行,只有格式化的东西)但是当我得到输入信息时,我得到了一个“运行时错误”#34; 438"对象不支持此属性或方法。'

从其他类似问题的先前答案中,我按照建议的方式做了所有事情,但我似乎无法让它发挥作用。

Option Compare Database
Option Explicit

Public Sub MaterialInput()

Dim xlapp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim RsClient As Recordset
Dim RsJobsite As Recordset
Dim db As Database
Dim ClientSTR As String
Dim JobsiteSTR As String
Dim customer As Variant

Set db = CurrentDb
JobsiteSTR = "SELECT T1Jobsites.JobsiteNickName FROM T1Jobsites WHERE T1Jobsites.JobsiteID = 1" ' & Form_LEM.TxtJobsiteID
Set RsJobsite = db.OpenRecordset(JobsiteSTR, dbOpenSnapshot, dbSeeChanges)

ClientSTR = "SELECT T1Companies.CompanyName " & _
            "FROM T1Companies INNER JOIN T1Jobsites ON T1Companies.CompanyID = T1Jobsites.CompanyId " & _
            "WHERE (((T1Jobsites.JobsiteID)=1))"
'ClientSTR = "SELECT T1Companies.CompanyName FROM T1Companies INNER JOIN T1Jobsites ON T1Companies.CompanyID = T1Jobsites.CompanyID" & _
                " WHERE T1JobsitesID = 1" '& Form_LEM.TxtJobsiteID
Set RsClient = db.OpenRecordset(ClientSTR, dbOpenSnapshot, dbSeeChanges)

Set xlapp = CreateObject("excel.application")


Set wb = xlapp.Workbooks.Open("C:\Users\coc33713\Desktop\VISION - EXCEL FILES\VISIONCOUNT.xlsm")
Set ws = xlapp.Worksheets("CountSheet")
xlapp.Visible = True

'Tried this second after reading another forum
'the comments Recordset will be the actual values used, but I can't get the String "TEST" to work

wb.ws.Range("Client").Value = "TEST"      'RsClient!CompanyName

'Tried this way first
xlapp.ws.Range("'SiteName'").Value = "Test"        'RsJobsite!JobsiteNickName"
xlapp.ws.Range(Date).Value = "Test"          'Form_LEM.TxtDate
xlapp.ws.Range(ProjectName).Value = "Test"     'Form_LEM.TxtPlant
xlapp.ws.Range(ScaffoldID).Value = "Test"    'Form_LEM.cboScaffnum.Value
xlapp.ws.Range(ScaffoldNumber).Value = "Test"       'Form_LEM.cboScaffnum.Column(1)

Set xlapp = Nothing
Set wb = Nothing
Set ws = Nothing
Set RsClient = Nothing
Set RsJobsite = Nothing
Set db = Nothing


End Sub

As a Sidenote this is not a form it is just spreadsheet 谢谢大家!

3 个答案:

答案 0 :(得分:2)

使用

ws.Range("Client").Value = "Test"

Dim sName as String
sName = "Client"

ws.Range(sName).Value = "Test"

原因是您已经设置了ws对象,因此无需再次为其分配父级。事实上,尝试这样做会破坏语法规则。

答案 1 :(得分:0)

FWIW(不是你的问题 - 由斯科特的回答解决):请注意  Set ws = xlapp.Worksheets("CountSheet") 应该 Set ws = wb.Worksheets("CountSheet")

使用xlapp.Worksheets("CountSheet") 有效xlApp.ActiveWorkbook.Worksheets("CountSheet")可能是({可能是} xlApp.Workbooks("VISION - EXCEL FILES\VISIONCOUNT.xlsm").Worksheets("CountSheet"),但最好是正确地做,而不是让它机会。

谢谢你们!

答案 2 :(得分:0)

这应该做你想要的。

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb") 
    ' open the database
    Set rs = db.OpenRecordset("TableName", dbOpenTable) 
    ' get all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("NamedRange1").Value
            .Fields("FieldName2") = Range("NamedRange2").Value
            .Fields("FieldNameN") = Range("NamedRangeN").Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub