Question

我正在寻求关于如何为以下要求构建excel宏的一个建议。请求您在EXCEL Only中提供您的宝贵意见。

方案我有一个电子表格＆＃34;产品大师＆＃34;包含所有产品详细信息。（即产品ID，产品名称，产品类型，数量等）

我正在使用excel VBA设计UserForm，任何人都可以根据其产品ID获取产品的所有详细信息。现在，所有产品详细信息都存在的产品主表将每天更新。每个用户都应该能够根据他的要求更新该表中的任何细节。

问题/质疑 我该如何设计我的系统？我的意思是我应该把我的＆＃34; Product-Master＆＃34;电子表格，以便多个用户可以访问它。我想的是将产品量块放在shared_drive上，以便所有人都可以通过VBA userform访问该表。我将为我办公室里的每个人提供excel VBA userform宏。他们将查询共享驱动器中的表单。这看起来好吗？

excel是否提供查询来自共享驱动器和放大器中的工作表的数据的工具。需要时更新它。我希望一次可以由多个用户查询。

我知道还有其他产品/技术提供比EXCEL更好的解决方案。但我只想在EXCEL中找到解决方案。

如果有人能就此发表他/她的宝贵意见，我将不胜感激。如果您需要任何细节，请告诉我。

谢谢你。

Answer 1

以下是从MS Access获取数据/向MS Access发送数据的一些示例函数（花了我一段时间来挖掘它们，哈哈！）。这使用了对Microsoft DAO 3.6对象库的引用，并且仅适用于旧的.mdb文件，而不是accdb（因为mdb驱动程序快100倍并且没有内存泄漏。）

Const DBPath As String = "Full\Database\Path"

Function GET_ACCESS_DATA(DBPath, SQL) As Object

    Dim dbConn As Object
    Dim dbRS As Object
    Dim SQL As String

    On Error GoTo ErrorHandler

    SQL = "Sql Query"

    'Set up database connection string
    Application.StatusBar = "Connecting to Database..."

    'Open database connection
    Set dbConn = OpenDatabase(DBPath)

    'Run the query
    Application.StatusBar = "Running Query..."
    Set dbRS = dbConn.OpenRecordset(SQL, DAO.dbOpenForwardOnly, DAO.RecordsetOptionEnum.dbReadOnly)

    'If no rows returned, display error message and exit
     If dbRS.RecordCount = 0 Then
        Application.StatusBar = "Running Query...Error"
        MsgBox "There are no records for the selected criteria.", vbInformation, "Refresh Data"
        Application.StatusBar = "REFRESHING DATA PLEASE WAIT.."
        Exit Function
    End If

    'returns DAO Recordset with the data

    Set GET_ACCESS_DATA = dbRS

    'A recordset can either be looped through or pasted to a spreadsheet with the Worksheet.Range.CopyFromRecordset method


'Error trap here
End Function


Function POST_TO_ACCESS() As Boolean

    POST_TO_ACCESS = False

    errormod = "TRACKING"
    On Error GoTo ERROR_TRAP:

    'START CONTROLS
    Application.StatusBar = "Formatting Data"

    St_Timer = Timer 'start connection timer
    Dim cn As DAO.Database
    Set cn = DAO.OpenDatabase(DBPath)
    En_Timer = Timer 'get connection time

    'SetKey Parameters
    UserNM = Replace(User_Name(), Chr(39), "")
    CompNm = Environ("COMPUTERNAME")

    Elapsed_Time = En_Timer - St_Timer
    SQL = "INSERT INTO TBL_TRACKING " & _
            "(UserNM) " & _
            " VALUES ('" & UserNM & "')"

    cn.Execute SQL

    cn.Close


    'END CONTROLS
    Application.StatusBar = False

    POST_TO_ACCESS = True

'error trap here
End Function

Function User_Name()

'This just gets the LDAP username of whoever is logged in. Useful for tracking. Not guarenteed to work for your Active Directory :)

    Dim WshNetwork
    Dim objAdoCon, objAdoCmd, objAdoRS
    Dim objUser, objRootDSE
    Dim strDomainDN, strUserName, strUserFullName

    strUserFullName = ""

    Set WshNetwork = CreateObject("WScript.Network")
    strUserName = WshNetwork.UserName

    Set objRootDSE = GetObject("LDAP://rootDSE")
    strDomainDN = objRootDSE.Get("defaultNamingContext")

    Set objAdoCon = CreateObject("ADODB.Connection")
    objAdoCon.Open "Provider=ADsDSOObject;"

    Set objAdoCmd = CreateObject("ADODB.Command")
    Set objAdoCmd.ActiveConnection = objAdoCon

    objAdoCmd.CommandText = _
      "SELECT ADsPath FROM 'LDAP://" & strDomainDN & "' WHERE " & _
      "objectCategory='person' AND objectClass='user' AND " & _
      "sAMAccountName='" & strUserName & "'"

    Set objAdoRS = objAdoCmd.Execute

    If (Not objAdoRS.EOF) Then
      Set objUser = GetObject(objAdoRS.Fields("ADsPath").Value)
      objUser.GetInfoEx Array("displayName"), 0
      strUserFullName = objUser.Get("displayName")
      Set objUser = Nothing

      User_Name = strUserFullName

    Else

    End If

    Set objAdoRS = Nothing
    Set objAdoCmd = Nothing
    objAdoCon.Close
    Set objAdoCon = Nothing

    Set objRootDSE = Nothing
    Set WshNetwork = Nothing

End Function

多个用户查询Excel - 需要建议

1 个答案: