Question

如何使用VBA查找SQL的服务器名和用户名？

Answer 1

Private Declare Function GetPrivateProfileStringA Lib _
    "Kernel32" (ByVal strSection As String, _
    ByVal strKey As String, ByVal strDefault As String, _
    ByVal strReturnedString As String, _
    ByVal lngSize As Long, ByVal strFileNameName As String) As Long
Private Declare Function WritePrivateProfileStringA Lib _
    "Kernel32" (ByVal strSection As String, _
    ByVal strKey As String, ByVal strString As String, _
    ByVal strFileNameName As String) As Long


Private Function WritePrivateProfileString32(ByVal strFileName As String, _
    ByVal strSection As String, ByVal strKey As String, _
    ByVal strValue As String) As Boolean
Dim lngValid As Long
    On Error Resume Next
    lngValid = WritePrivateProfileStringA(strSection, strKey, _
        strValue, strFileName)
    If lngValid > 0 Then WritePrivateProfileString32 = True
    On Error GoTo 0
End Function


Private Function GetPrivateProfileString32(ByVal strFileName As String, _
    ByVal strSection As String, ByVal strKey As String, _
    Optional strDefault) As String
Dim strReturnString As String, lngSize As Long, lngValid As Long
    On Error Resume Next
    If IsMissing(strDefault) Then strDefault = ""
    strReturnString = Space(1024)
    lngSize = Len(strReturnString)
    lngValid = GetPrivateProfileStringA(strSection, strKey, _
        strDefault, strReturnString, lngSize, strFileName)
    GetPrivateProfileString32 = Left(strReturnString, lngValid)
    On Error GoTo 0
End Function


' the examples below assumes that the range B3:B5 in the active sheet contains
' information about Lastname, Firstname and Birthdate


Sub WriteUserInfo()
    sFile = "D:\abc.TXT"
' saves information in the file IniFileName
    If Not WritePrivateProfileString32(sFile, "PERSONAL", _
        "Lastname", Range("B3").Value) Then
        MsgBox "Not able to save user info in " & IniFileName, _
            vbExclamation, "Folder does not exist!"
        Exit Sub
    End If
    WritePrivateProfileString32 sFile, "PERSONAL", _
        "Birthdate", "aaa"

End Sub


Public Function ReadUserInfo(sAttribute)
Dim sFile As String
    sFile = ThisWorkbook.Path + "\Input.ini"
    ReadUserInfo = GetPrivateProfileString32(sFile, "CONFIGURATION", sAttribute)
End Function


' the example below assumes that the range D4 in the active sheet contains
' information about the unique number


Sub GetNewUniqueNumber()
Dim UniqueNumber As Long
    If Dir(IniFileName) = "" Then Exit Sub
    UniqueNumber = 0
    On Error Resume Next
    UniqueNumber = CLng(GetPrivateProfileString32(IniFileName, _
        "PERSONAL", "UniqueNumber"))
    On Error GoTo 0
    Range("D4").Formula = UniqueNumber + 1
    If Not WritePrivateProfileString32(IniFileName, "PERSONAL", _
        "UniqueNumber", Range("D4").Value) Then
        MsgBox "Not able to save user info in " & IniFileName, _
            vbExclamation, "Folder does not exist!"
        Exit Sub
    End If
End Sub



Private Sub getInfo()
    MsgBox ThisWorkbook.Path

End Sub

Public Function ValidateInput(sSheetName As String, Optional bPortfolio As Boolean) As Boolean

    Dim bValidate As Boolean
    bValidate = True

     If Worksheets(sSheetName).cmbYear.ListIndex < 1 Then
        MsgBox "Please select Year"
        bValidate = False

     ElseIf Worksheets(sSheetName).cmbMonth.ListIndex < 1 Then
        MsgBox "Please select Month"
        bValidate = False

    End If

    ValidateInput = bValidate

End Function


Public Function GetDateClause()

   Dim sYear As String, sMonth As String, sRetDates As Variant
   Dim dFromdate As Date, dToDate As Date
   Dim interval As Integer

   interval = -12
   dToDate = CDate(CStr(Worksheets("UI").cbYear.Value & "/" & (Worksheets("UI").cbMonth.ListIndex)))
   dFromdate = DateAdd("M", interval, dToDate)

   sRetDates = Year(dFromdate) & Right("0" & Month(dFromdate), 2) & "::" & Year(dToDate) & Right("0" & Month(dToDate), 2) & "::" & dFromdate

   GetDateClause = sRetDates
End Function



Public Sub DateFilter()

'Set the Variables to be used
Dim pt As PivotTable

'Amend here to filter your data
Set pt = Worksheets("PivotTables").PivotTables("PivotTable1")
    pt.PivotFields("Date").ClearAllFilters 'This line is needed to clear existing filter before applying new one
   pt.PivotFields("Date").PivotFilters.Add Type:=xlDateBetween, _
        Value1:=CLng((Range("SDate").Value)), Value2:=CLng((Range("EDate").Value))

End Sub

如何使用VBA查找SQL的服务器名和用户名？

1 个答案: