vbscript 使用没有指定体系结构的StdRegProv类通过VBScript进行WMI注册表调用（GetStringValue）
使用没有指定体系结构的StdRegProv类通过VBScript进行WMI注册表调用（GetStringValue）
arch_wmi_conn_setdwordvalue.vbs
Const HKEY_LOCAL_MACHINE = &H80000002, HKLM = &H80000002
WScript.Echo SetStringValue (".", HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Client Service", "InstallDir", 0, 32)
WScript.Echo SetStringValue (".", HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Client Service", "InstallDir", 0, 64)
Function SetDWordValue (ByVal Resource, ByVal hDefKey, ByVal SubKeyName, ByVal ValueName, ByVal Value, ByVal Architecture)
Const wbemAuthenticationLevelPktPrivacy = 6
Const wbemImpersonationLevelImpersonate = 3
Dim oCtx: Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
oCtx.Add "__ProviderArchitecture", Architecture
oCtx.Add "__RequiredArchitecture", True
Dim oLocator: Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
oLocator.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
oLocator.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
Dim oReg: Set oReg = oLocator.ConnectServer(Resource, "root\default", "", "", , , , oCtx).Get("StdRegProv")
Dim oInParams: Set oInParams = oReg.Methods_("SetDWordValue").InParameters
oInParams.hDefKey = hDefKey
oInParams.sSubKeyName = SubKeyName
oInParams.sValueName = ValueName
oInParams.uValue = Value
Dim oOutParams: Set oOutParams = oReg.ExecMethod_("SetDWordValue", oInParams, , oCtx)
SetDWordValue = oOutParams.ReturnValue
End Function
arch_wmi_conn_getstringvalue.vbs
Const HKEY_LOCAL_MACHINE = &H80000002, HKLM = &H80000002
WScript.Echo GetStringValue (".", HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Client Service", "InstallDir", 32)
WScript.Echo GetStringValue (".", HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Client Service", "InstallDir", 64)
Function GetStringValue (ByVal Resource, ByVal hDefKey, ByVal SubKeyName, ByVal ValueName, ByVal Architecture)
Const wbemAuthenticationLevelPktPrivacy = 6
Const wbemImpersonationLevelImpersonate = 3
Dim oCtx: Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
oCtx.Add "__ProviderArchitecture", Architecture
oCtx.Add "__RequiredArchitecture", True
Dim oLocator: Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
oLocator.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
oLocator.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
Dim oReg: Set oReg = oLocator.ConnectServer(Resource, "root\default", "", "", , , , oCtx).Get("StdRegProv")
Dim oInParams: Set oInParams = oReg.Methods_("GetStringValue").InParameters
oInParams.hDefKey = hDefKey
oInParams.sSubKeyName = SubKeyName
oInParams.sValueName = ValueName
Dim oOutParams: Set oOutParams = oReg.ExecMethod_("GetStringValue", oInParams, , oCtx)
GetStringValue = oOutParams.sValue
End Function
arch_wmi_conn_getdwordvalue.vbs
Const HKEY_LOCAL_MACHINE = &H80000002, HKLM = &H80000002
WScript.Echo GetDWordValue (".", HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Client Service", "UserInfoInterval", 32)
WScript.Echo GetDWordValue (".", HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Client Service", "UserInfoInterval", 64)
Function GetDWordValue (ByVal Resource, ByVal hDefKey, ByVal SubKeyName, ByVal ValueName, ByVal Architecture)
Const wbemAuthenticationLevelPktPrivacy = 6
Const wbemImpersonationLevelImpersonate = 3
Dim oCtx: Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
oCtx.Add "__ProviderArchitecture", Architecture
oCtx.Add "__RequiredArchitecture", True
Dim oLocator: Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
oLocator.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
oLocator.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
Dim oReg: Set oReg = oLocator.ConnectServer(Resource, "root\default", "", "", , , , oCtx).Get("StdRegProv")
Dim oInParams: Set oInParams = oReg.Methods_("GetDWORDValue").InParameters
oInParams.hDefKey = hDefKey
oInParams.sSubKeyName = SubKeyName
oInParams.sValueName = ValueName
Dim oOutParams: Set oOutParams = oReg.ExecMethod_("GetDWORDValue", oInParams, , oCtx)
GetDWordValue = oOutParams.uValue
End Functionvbscript 使用StdRegProv类通过VBScript调用WMI注册表，但未指定体系结构
使用StdRegProv类通过VBScript调用WMI注册表，但未指定体系结构
no_arch_wmi.conn.vbs
Const HKEY_LOCAL_MACHINE = &H80000002, HKLM = &H80000002
Dim StdRegProv: Set StdRegProv = GetObject("winmgmts:{impersonationlevel=impersonate}!//./root/default:StdRegProv")
Dim InstallDir: StdRegProv.GetStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Altiris\Client Service", "InstallDir", InstallDir
WScript.Echo InstallDirvbscript 第2部分我从安德鲁那里得到的代码是进出excel和/或进出的代码
第2部分我从安德鲁那里得到的代码是进出excel和/或进出的代码
import_export2.vbs
Public Sub SaveToDB(ByVal iRowIndex As Long)
Dim conn As New OleDbConnection
Dim sConnString As String
Dim cmd As New OleDbCommand
Dim sSQL As String = String.Empty
Try
'Check if the path has a backslash in the end of string
If Microsoft.VisualBasic.Right(Application.StartupPath, 1) = "\" Then
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Application.StartupPath & "dbexport.accdb;Persist Security Info=False;"
Else
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Application.StartupPath & "\dbexport.accdb;Persist Security Info=False;"
End If
'create a new instance of connection
conn = New OleDbConnection(sConnString)
'open the connection to be used by command object
conn.Open()
'Set the command's connection to our opened connection
cmd.Connection = conn
'Set the command type to CommandType.Text in order to use SQL statment constructed here
'in code editor
cmd.CommandType = CommandType.Text
'Set the comment text to insert the data to database
cmd.CommandText = "INSERT INTO students_grade ( student_no, student_name, grade ) VALUES(@student_no, @student_name, @grade)"
'Add parameters in order to set the values in the query
cmd.Parameters.Add("@student_no", OleDbType.VarChar).Value = dtExcelData.Rows(iRowIndex)(0)
cmd.Parameters.Add("@student_name", OleDbType.VarChar).Value = dtExcelData.Rows(iRowIndex)(1)
'This is just a sample of how to check if the field is null.
cmd.Parameters.Add("@grade", OleDbType.Numeric).Value = IIf(Not IsDBNull(dtExcelData.Rows(iRowIndex)(2)), dtExcelData.Rows(iRowIndex)(2), Nothing)
cmd.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ErrorToString)
Finally
conn.Close()
End Try
End Sub
Public Sub Load_Data()
Dim conn As New OleDbConnection
Dim sConnString As String
Dim cmd As New OleDbCommand
Dim da As New OleDbDataAdapter
Try
'create a new instance of dtStudentGrade, this datatable will be used to export
'data from database to excel
dtStudentGrade = New DataTable
'Check if the path has a backslash in the end of string
If Microsoft.VisualBasic.Right(Application.StartupPath, 1) = "\" Then
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Application.StartupPath & "dbexport.accdb;Persist Security Info=False;"
Else
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Application.StartupPath & "\dbexport.accdb;Persist Security Info=False;"
End If
'create a new instance of connection
conn = New OleDbConnection(sConnString)
'open the connection to be used by command object
conn.Open()
'Set the command's connection to our opened connection
cmd.Connection = conn
'Set the command type to CommandType.Text in order to use SQL statment constructed here
'in code editor
cmd.CommandType = CommandType.Text
'Set the comment text to load the data from database
cmd.CommandText = "select * from students_grade"
'assign the cmd object to dataadapter selectcommand property in order to use it to fill the dtStudentGrade
da.SelectCommand = cmd
'Populate the dtStudentGrade with the data from database
da.Fill(dtStudentGrade)
'Set the datagridview datasource to dtStudentGrade in order to dispaly the data to user
dtgResult.DataSource = dtStudentGrade
Catch ex As Exception
MsgBox(ErrorToString)
Finally
conn.Close()
End Try
End Sub
Public Sub ImportToDB()
'Create a new instance of dtExcelData datatable
dtExcelData = New DataTable
'Set the cursor to wait cursor
Windows.Forms.Cursor.Current = Cursors.WaitCursor
'Call ReadExcelFile function to get the data from excel
dtExcelData = ReadExcelFile()
'Reset the progressbar
Me.ProgressBar1.Value = 0
'Get the DataTable row count to set the progressbar maximum value
Me.ProgressBar1.Maximum = dtExcelData.Rows.Count
Me.ProgressBar1.Visible = True
'Use looping to read the value of field in each row in DataTable
For i = 0 To dtExcelData.Rows.Count - 1
'Check if the student number has a value
If Not IsDBNull(dtExcelData.Rows(i)(0)) Then
'call save procedure and pass the row varialble i(row index) as parameter to save each the value of each field
SaveToDB(i)
'Increase the value of progressbar to inform the user.
Me.ProgressBar1.Value = Me.ProgressBar1.Value + 1
End If
Next
dtExcelData = Nothing
'Call the Load_Data procedure that will load the data and display it to DataGrid
Load_Data()
'Inform the user that the importing of data has been finished
MsgBox("Data has successfully imported.", MsgBoxStyle.OkOnly, "Import Export Demo")
End Sub
Private Sub btnImport_Click(sender As System.Object, e As System.EventArgs) Handles btnImport.Click
'Check if there's a selected excel file to be imported
If Len(Trim(Me.lbFilePath.Text)) > 0 Then
ImportToDB()
Else
'Inform the user if no selected excel file.
MsgBox("Please select a file.", MsgBoxStyle.OkOnly, "Import Export Demo")
End If
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
'Call the release object function to release the object before disposing
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
'Call the Garbage collector to free the resources consumed by created instances
GC.Collect()
End Try
End Sub
Private Sub ExportExcel()
'Create excel objects
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim oValue As Object = System.Reflection.Missing.Value
Dim sPath As String = String.Empty
'cereate new object SaveFileDialog that will be use to save the file
Dim dlgSave As New SaveFileDialog
'Create a new instance of databale, this will server as container of data
Dim dt As New DataTable
'We need to set the default extension to xls so the SaveFileDialog will save the file
'as excel file
dlgSave.DefaultExt = "xls"
'Set the filter for SaveFileDialog
dlgSave.Filter = "Microsoft Excel|*.xls"
'set the initial path, you may set a different path if you like
dlgSave.InitialDirectory = Application.StartupPath
'Export the data if the user click the ok button of SaveFileDialog
If dlgSave.ShowDialog = Windows.Forms.DialogResult.OK Then
Try
'Create a new instance of excel application
xlApp = New Microsoft.Office.Interop.Excel.Application
'Create an excel workbook
xlBook = xlApp.Workbooks.Add(oValue)
'Create an excel sheet named sheet1
xlSheet = xlBook.Worksheets("sheet1")
Dim xlRow As Long = 2
Dim xlCol As Short = 1
'To create a column for excel we need to loop through DataTable(dtStudentGrade)
For Each col As DataColumn In dtStudentGrade.Columns
'Get the column name and assigned it to excel sheet cells
'to assign value to each cell we need to specify the row and column xlSheet.Cells(row, column)
xlSheet.Cells(1, xlCol) = col.ColumnName
'Increment the xlCol so we can set another column
xlCol += 1
Next
'reset the progressbar
Me.ProgressBar1.Visible = True
Me.ProgressBar1.Minimum = 0
Me.ProgressBar1.Maximum = dtStudentGrade.Rows.Count
'Loop through dtStudentGrade to get the value of each field in a row
For Each row As DataRow In dtStudentGrade.Rows
'Reset xlCol's value to 1
xlCol = 1
'Loop through dtStudentGrade and set the value of each excel sheet cells
For Each col As DataColumn In dtStudentGrade.Columns
'Assign the value of each field to selected excel sheet cell
xlSheet.Cells(xlRow, xlCol) = row(xlCol - 1)
'Increment the xlCol so we can set another the the value of another cell
xlCol += 1
Next
'Increment the xlCol
xlRow += 1
'Set the value of progressbar
If Me.ProgressBar1.Maximum > Me.ProgressBar1.Value + 1 Then
Me.ProgressBar1.Value = Me.ProgressBar1.Value + 1
End If
Next
'Set the filename and set the filename to xlx to save the file as excel 2003
'You may remove the Replace function and save the file with xlsx(excel 2007) extension
Dim sFileName As String = Replace(dlgSave.FileName, ".xlsx", "xlx")
'save the file
xlSheet.SaveAs(sFileName)
'close the workbook
xlBook.Close()
'Quit the application using this code
xlApp.Quit()
'Release the objects used by excell application by calling our procedure releaseObject
releaseObject(xlApp)
releaseObject(xlBook)
releaseObject(xlSheet)
'Reset the progressbar
Me.ProgressBar1.Value = 0
Me.ProgressBar1.Visible = False
'inform the user if successfull
MsgBox("Data successfully exported.", MsgBoxStyle.Information, "PRMS/SOB Date Tagging")
Catch
MsgBox(ErrorToString)
Finally
End Try
End If
End Sub
Private Sub btnExport_Click(sender As System.Object, e As System.EventArgs) Handles btnExport.Click
ExportExcel()
End Sub
End Classvbscript 第2部分我从安德鲁那里得到的代码是进出excel和/或进出的代码
第2部分我从安德鲁那里得到的代码是进出excel和/或进出的代码
import_export2.vbs
Public Sub SaveToDB(ByVal iRowIndex As Long)
Dim conn As New OleDbConnection
Dim sConnString As String
Dim cmd As New OleDbCommand
Dim sSQL As String = String.Empty
Try
'Check if the path has a backslash in the end of string
If Microsoft.VisualBasic.Right(Application.StartupPath, 1) = "\" Then
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Application.StartupPath & "dbexport.accdb;Persist Security Info=False;"
Else
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Application.StartupPath & "\dbexport.accdb;Persist Security Info=False;"
End If
'create a new instance of connection
conn = New OleDbConnection(sConnString)
'open the connection to be used by command object
conn.Open()
'Set the command's connection to our opened connection
cmd.Connection = conn
'Set the command type to CommandType.Text in order to use SQL statment constructed here
'in code editor
cmd.CommandType = CommandType.Text
'Set the comment text to insert the data to database
cmd.CommandText = "INSERT INTO students_grade ( student_no, student_name, grade ) VALUES(@student_no, @student_name, @grade)"
'Add parameters in order to set the values in the query
cmd.Parameters.Add("@student_no", OleDbType.VarChar).Value = dtExcelData.Rows(iRowIndex)(0)
cmd.Parameters.Add("@student_name", OleDbType.VarChar).Value = dtExcelData.Rows(iRowIndex)(1)
'This is just a sample of how to check if the field is null.
cmd.Parameters.Add("@grade", OleDbType.Numeric).Value = IIf(Not IsDBNull(dtExcelData.Rows(iRowIndex)(2)), dtExcelData.Rows(iRowIndex)(2), Nothing)
cmd.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ErrorToString)
Finally
conn.Close()
End Try
End Sub
Public Sub Load_Data()
Dim conn As New OleDbConnection
Dim sConnString As String
Dim cmd As New OleDbCommand
Dim da As New OleDbDataAdapter
Try
'create a new instance of dtStudentGrade, this datatable will be used to export
'data from database to excel
dtStudentGrade = New DataTable
'Check if the path has a backslash in the end of string
If Microsoft.VisualBasic.Right(Application.StartupPath, 1) = "\" Then
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Application.StartupPath & "dbexport.accdb;Persist Security Info=False;"
Else
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Application.StartupPath & "\dbexport.accdb;Persist Security Info=False;"
End If
'create a new instance of connection
conn = New OleDbConnection(sConnString)
'open the connection to be used by command object
conn.Open()
'Set the command's connection to our opened connection
cmd.Connection = conn
'Set the command type to CommandType.Text in order to use SQL statment constructed here
'in code editor
cmd.CommandType = CommandType.Text
'Set the comment text to load the data from database
cmd.CommandText = "select * from students_grade"
'assign the cmd object to dataadapter selectcommand property in order to use it to fill the dtStudentGrade
da.SelectCommand = cmd
'Populate the dtStudentGrade with the data from database
da.Fill(dtStudentGrade)
'Set the datagridview datasource to dtStudentGrade in order to dispaly the data to user
dtgResult.DataSource = dtStudentGrade
Catch ex As Exception
MsgBox(ErrorToString)
Finally
conn.Close()
End Try
End Sub
Public Sub ImportToDB()
'Create a new instance of dtExcelData datatable
dtExcelData = New DataTable
'Set the cursor to wait cursor
Windows.Forms.Cursor.Current = Cursors.WaitCursor
'Call ReadExcelFile function to get the data from excel
dtExcelData = ReadExcelFile()
'Reset the progressbar
Me.ProgressBar1.Value = 0
'Get the DataTable row count to set the progressbar maximum value
Me.ProgressBar1.Maximum = dtExcelData.Rows.Count
Me.ProgressBar1.Visible = True
'Use looping to read the value of field in each row in DataTable
For i = 0 To dtExcelData.Rows.Count - 1
'Check if the student number has a value
If Not IsDBNull(dtExcelData.Rows(i)(0)) Then
'call save procedure and pass the row varialble i(row index) as parameter to save each the value of each field
SaveToDB(i)
'Increase the value of progressbar to inform the user.
Me.ProgressBar1.Value = Me.ProgressBar1.Value + 1
End If
Next
dtExcelData = Nothing
'Call the Load_Data procedure that will load the data and display it to DataGrid
Load_Data()
'Inform the user that the importing of data has been finished
MsgBox("Data has successfully imported.", MsgBoxStyle.OkOnly, "Import Export Demo")
End Sub
Private Sub btnImport_Click(sender As System.Object, e As System.EventArgs) Handles btnImport.Click
'Check if there's a selected excel file to be imported
If Len(Trim(Me.lbFilePath.Text)) > 0 Then
ImportToDB()
Else
'Inform the user if no selected excel file.
MsgBox("Please select a file.", MsgBoxStyle.OkOnly, "Import Export Demo")
End If
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
'Call the release object function to release the object before disposing
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
'Call the Garbage collector to free the resources consumed by created instances
GC.Collect()
End Try
End Sub
Private Sub ExportExcel()
'Create excel objects
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim oValue As Object = System.Reflection.Missing.Value
Dim sPath As String = String.Empty
'cereate new object SaveFileDialog that will be use to save the file
Dim dlgSave As New SaveFileDialog
'Create a new instance of databale, this will server as container of data
Dim dt As New DataTable
'We need to set the default extension to xls so the SaveFileDialog will save the file
'as excel file
dlgSave.DefaultExt = "xls"
'Set the filter for SaveFileDialog
dlgSave.Filter = "Microsoft Excel|*.xls"
'set the initial path, you may set a different path if you like
dlgSave.InitialDirectory = Application.StartupPath
'Export the data if the user click the ok button of SaveFileDialog
If dlgSave.ShowDialog = Windows.Forms.DialogResult.OK Then
Try
'Create a new instance of excel application
xlApp = New Microsoft.Office.Interop.Excel.Application
'Create an excel workbook
xlBook = xlApp.Workbooks.Add(oValue)
'Create an excel sheet named sheet1
xlSheet = xlBook.Worksheets("sheet1")
Dim xlRow As Long = 2
Dim xlCol As Short = 1
'To create a column for excel we need to loop through DataTable(dtStudentGrade)
For Each col As DataColumn In dtStudentGrade.Columns
'Get the column name and assigned it to excel sheet cells
'to assign value to each cell we need to specify the row and column xlSheet.Cells(row, column)
xlSheet.Cells(1, xlCol) = col.ColumnName
'Increment the xlCol so we can set another column
xlCol += 1
Next
'reset the progressbar
Me.ProgressBar1.Visible = True
Me.ProgressBar1.Minimum = 0
Me.ProgressBar1.Maximum = dtStudentGrade.Rows.Count
'Loop through dtStudentGrade to get the value of each field in a row
For Each row As DataRow In dtStudentGrade.Rows
'Reset xlCol's value to 1
xlCol = 1
'Loop through dtStudentGrade and set the value of each excel sheet cells
For Each col As DataColumn In dtStudentGrade.Columns
'Assign the value of each field to selected excel sheet cell
xlSheet.Cells(xlRow, xlCol) = row(xlCol - 1)
'Increment the xlCol so we can set another the the value of another cell
xlCol += 1
Next
'Increment the xlCol
xlRow += 1
'Set the value of progressbar
If Me.ProgressBar1.Maximum > Me.ProgressBar1.Value + 1 Then
Me.ProgressBar1.Value = Me.ProgressBar1.Value + 1
End If
Next
'Set the filename and set the filename to xlx to save the file as excel 2003
'You may remove the Replace function and save the file with xlsx(excel 2007) extension
Dim sFileName As String = Replace(dlgSave.FileName, ".xlsx", "xlx")
'save the file
xlSheet.SaveAs(sFileName)
'close the workbook
xlBook.Close()
'Quit the application using this code
xlApp.Quit()
'Release the objects used by excell application by calling our procedure releaseObject
releaseObject(xlApp)
releaseObject(xlBook)
releaseObject(xlSheet)
'Reset the progressbar
Me.ProgressBar1.Value = 0
Me.ProgressBar1.Visible = False
'inform the user if successfull
MsgBox("Data successfully exported.", MsgBoxStyle.Information, "PRMS/SOB Date Tagging")
Catch
MsgBox(ErrorToString)
Finally
End Try
End If
End Sub
Private Sub btnExport_Click(sender As System.Object, e As System.EventArgs) Handles btnExport.Click
ExportExcel()
End Sub
End Classvbscript MS Access中的超时功能
MS Access中的超时功能
timeoutModule.vbs
Sub IdleTimeDetected(ExpiredMinutes)
Dim Msg As String
Msg = "No user activity detected in the last "
Msg = Msg & ExpiredMinutes & " minute(s)!"
MsgBox Msg, 48
End Sub
timeoutOnTimer.vbs
Sub Form_Timer()
' IDLEMINUTES determines how much idle time to wait for before
' running the IdleTimeDetected subroutine.
Const IDLEMINUTES = 5
Static PrevControlName As String
Static PrevFormName As String
Static ExpiredTime
Dim ActiveFormName As String
Dim ActiveControlName As String
Dim ExpiredMinutes
On Error Resume Next
' Get the active form and control name.
ActiveFormName = Screen.ActiveForm.Name
If Err Then
ActiveFormName = "No Active Form"
Err = 0
End If
ActiveControlName = Screen.ActiveControl.Name
If Err Then
ActiveControlName = "No Active Control"
Err = 0
End If
' Record the current active names and reset ExpiredTime if:
' 1. They have not been recorded yet (code is running
' for the first time).
' 2. The previous names are different than the current ones
' (the user has done something different during the timer
' interval).
If (PrevControlName = "") Or (PrevFormName = "") _
Or (ActiveFormName <> PrevFormName) _
Or (ActiveControlName <> PrevControlName) Then
PrevControlName = ActiveControlName
PrevFormName = ActiveFormName
ExpiredTime = 0
Else
' ...otherwise the user was idle during the time interval, so
' increment the total expired time.
ExpiredTime = ExpiredTime + Me.TimerInterval
End If
' Does the total expired time exceed the IDLEMINUTES?
ExpiredMinutes = (ExpiredTime / 1000) / 60
If ExpiredMinutes >= IDLEMINUTES Then
' ...if so, then reset the expired time to zero...
ExpiredTime = 0
' ...and call the IdleTimeDetected subroutine.
IdleTimeDetected ExpiredMinutes
End If
End Subvbscript MS Access中的超时功能
MS Access中的超时功能
timeoutModule.vbs
Sub IdleTimeDetected(ExpiredMinutes)
Dim Msg As String
Msg = "No user activity detected in the last "
Msg = Msg & ExpiredMinutes & " minute(s)!"
MsgBox Msg, 48
End Sub
timeoutOnTimer.vbs
Sub Form_Timer()
' IDLEMINUTES determines how much idle time to wait for before
' running the IdleTimeDetected subroutine.
Const IDLEMINUTES = 5
Static PrevControlName As String
Static PrevFormName As String
Static ExpiredTime
Dim ActiveFormName As String
Dim ActiveControlName As String
Dim ExpiredMinutes
On Error Resume Next
' Get the active form and control name.
ActiveFormName = Screen.ActiveForm.Name
If Err Then
ActiveFormName = "No Active Form"
Err = 0
End If
ActiveControlName = Screen.ActiveControl.Name
If Err Then
ActiveControlName = "No Active Control"
Err = 0
End If
' Record the current active names and reset ExpiredTime if:
' 1. They have not been recorded yet (code is running
' for the first time).
' 2. The previous names are different than the current ones
' (the user has done something different during the timer
' interval).
If (PrevControlName = "") Or (PrevFormName = "") _
Or (ActiveFormName <> PrevFormName) _
Or (ActiveControlName <> PrevControlName) Then
PrevControlName = ActiveControlName
PrevFormName = ActiveFormName
ExpiredTime = 0
Else
' ...otherwise the user was idle during the time interval, so
' increment the total expired time.
ExpiredTime = ExpiredTime + Me.TimerInterval
End If
' Does the total expired time exceed the IDLEMINUTES?
ExpiredMinutes = (ExpiredTime / 1000) / 60
If ExpiredMinutes >= IDLEMINUTES Then
' ...if so, then reset the expired time to zero...
ExpiredTime = 0
' ...and call the IdleTimeDetected subroutine.
IdleTimeDetected ExpiredMinutes
End If
End Subvbscript 用于从财务代码中提取出生日期+性别...的VBA脚本
用于从财务代码中提取出生日期+性别...的VBA脚本
new_gist_file.vbs
Private Sub doExtraction()
Cells(2, 10).Activate
Do While ActiveCell.Offset(0, -9).Text <> ""
Dim fiscal
fiscal = ActiveCell.Value
If Len(fiscal) = 16 Then
ActiveCell.Offset(0, 1).Value = ExtractGender(fiscal)
ActiveCell.Offset(0, 2).Value = ExtractBirthdate(fiscal)
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Private Function ExtractGender(ByVal fiscalcode As String)
Dim genderDay
genderDay = Mid(fiscalcode, 10, 2)
If genderDay > 40 Then
ExtractGender = "W"
Else
ExtractGender = "M"
End If
End Function
Private Function ExtractBirthdate(ByVal fiscalcode As String)
Dim month, months, day, year As String
months = "ABCDEHLMPRST"
fiscalMonthIdx = Mid(fiscalcode, 9, 1)
month = InStr(months, fiscalMonthIdx)
day = Mid(fiscalcode, 10, 2)
day = day Mod 40
year = Mid(fiscalcode, 7, 2)
ExtractBirthdate = day & "." & month & ".19" & year
End Function
vbscript 获取Access中最后插入记录的ID
获取Access中最后插入记录的ID
autonumber.vbs
'Get the value of the autonumber field for the last record inserted into an Access database via the current connection.
set rst = objConn.Execute("SELECT @@IDENTITY")
id = rst(0)vbscript 使用VBS在Windows上安装新字体
使用VBS在Windows上安装新字体
install_new_fonts.vbs
' http://blogs.technet.com/b/rspitz/archive/2010/09/25/how-to-install-a-font-from-the-command-line-on-windows-7.aspx
strPathFonts = "\\share\fonts"
set Shell = WScript.CreateObject("WScript.Shell")
strWindir = Shell.ExpandEnvironmentStrings("%windir%")
set fso = CreateObject("Scripting.FileSystemObject")
set f = fso.GetFolder(strPathFonts)
Set fc = f.Files
For Each fl in fc
'wscript.echo strWindir + "\fonts\" +fl.name
if (fso.FileExists("C:\Windows\Fonts\" +fl.name)) then
'wscript.echo "existiert bereits"
else
'wscript.echo "install ..."
installFont strPathFonts, fl.name
end if
Next
function installFont(path, file)
set objShell = CreateObject("Shell.Application")
set objFolder = objShell.Namespace(path)
set objFolderItem = objFolder.ParseName(file)
objFolderItem.InvokeVerb("Install")
end functionvbscript 导出OU计算机
VBScript：导出OU计算机
Export_OU_Computers.vbs
Const ADS_SCOPE_SUBTREE = 200
strExportFile = "AD_OU_Export_Computers.csv"
strSelectAttr = "cn, operatingSystem, operatingSystemServicePack"
' Get OU
strOU = "OU=Laptops W7,OU=Organisatie,DC=VERZ,DC=LOCAL"
' Create connection to AD
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
' Create command
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
' Execute command to get all users in OU
objCommand.CommandText = _
"Select " & strSelectAttr & " from 'LDAP://" & strOU & "' " _
& "Where objectClass='computer'"
Set objRecordSet = objCommand.Execute
' Create the Export File
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptDir = Left(WScript.ScriptFullName, (Len(WScript.ScriptFullName))-(Len(WScript.ScriptName)))
strExportFileName = strScriptDir & strExportFile
Set ExportFile = objFSO.OpenTextFile(strExportFileName, 2, True)
ExportFile.WriteLine("CN;operatingSystem;operatingSystemServicePack")
' Show info for each user in OU
Do Until objRecordSet.EOF
' Export required info for a computer
ExportFile.WriteLine(objRecordSet.Fields("cn").Value & ";" & _
objRecordSet.Fields("operatingSystem").Value & ";" & _
objRecordSet.Fields("operatingSystemServicePack").Value)
' Move to the next user
objRecordSet.MoveNext
Loop
' Close the Export File
ExportFile.Close
' Clean up
objRecordSet.Close
Set objRecordSet = Nothing
Set objCommand = Nothing
objConnection.Close
Set objConnection = Nothing
MsgBox "Klaar"