none
Scrip de Logon Para Adicionar Impressoras e Mapear unidades de Rede RRS feed

  • Pergunta

  • Bom Dia...

    No script abaixo eu utilizo um arquivo .txt para configurar impressoras e mapear unidades

    Eu queria saber se ao inves de usar um arquivo de configuração .txt (bloco de notas) eu poderia usar um .xls (excel)

    Se sim,Quais alterações deveria fazer e como ficaria o script?

    'SCRIT

    Option Explicit  'Obrigar a declaracao das variaveis
    On Error Resume Next

    Dim strNomeMaquina,strTmp,strDepartamento,strUsuario,strIP,strLocalMaquina,strPath
    Dim mapeamentos,impressoras,objShell,ImpNet,hora,saudacao,ad,maquina,letra
    Dim WshSysEnv,strOS

    Set objShell = CreateObject("WScript.Shell")
    Set ImpNet = CreateObject("WScript.Network")

           
    '*****************************Inicializando as variaveis*******************************************************

    '----Verifica o sistem operacinal atual---
    Set WshSysEnv = objShell.Environment("SYSTEM")
     
    If WshSysEnv = "Windows_NT" Then
        strOS = "NT"
    Else
        strOS = "9X"
    End If
    '-----------------------------------------

    strPath = Left( WSCript.ScriptFullName,len(WSCript.ScriptFullName)-Len(WSCript.ScriptName))
    'Pegar o path em que o script esta rodando

    strNomeMaquina = ImpNet.ComputerName 'Pega o nome da maquina (Host Name)

    '-----Retorna o Departamento da Maquina dependedo do Host Name da maquina (Nome do PC)
        strTmp = Split(strNomeMaquina , "-")
        'Funcao para criar uma array apartir de uma String, onde o caracter "-" eh o separador
        If UBound(strTmp)>=1 Then
            'Se o tamanho da Array for maior do que 1
            strDepartamento = strTmp(1)
            'Caso esteja no padrao de nome de maquina "LOCAL-DPTO-001" o indice 1 sera o nome do depto
        Else
            'Se o tamanho da Array for menor do que 1 (Caso naum tenha o caracter "-")
            strDepartamento = strTmp(0)
            'Caso naum esteja no padrao pega o indice 0, nome completo da maquina.
        End If
    '----------------------------------------------------------------------------------------

    strLocalMaquina = strTmp(0) 'Pega o local em que a maquina esta (LOCAL-DEPTO-001)
    strUsuario = LCASE(ImpNet.UserName) 'Pega o usuario logado

    '**************************************************************************************************************


    'if strOS = "NT" then remover_mapeamento_impressoras()
    remover_mapeamento_unidades_rede()



    mapear_tudo()
    'Chama a funcao para mapear unidades de rede e impressoras conforme arquivo de configuracao
     
    definir_imagem_desktop "DefaultCB.bgi" 'Chama a funcao para mudar a imagem da area de trabalho


    If Err.Number<>0 Then Tratar_Erro "main()","Erro no main"
    'Caso de algum erro chama funcao para tratamento de erro


    'objShell.Popup "Local: " & strLocalMaquina & CHR(13) & _
    '       "Maquina: " & strNomeMaquina & CHR(13) & _
    '       "Departamento: " & strDepartamento & CHR(13) & _
    '       "Usuario: " & strUsuario & CHR(13) & _
    '       "Impressoras a mapear: " & impressoras & CHR(13) & _
    '       "-------------------------------------- " &  CHR(13) & _
    '       "Unidades a mapear: " & mapeamentos & CHR(13)



    hora = time()
    if ((hora >= "06:00") and (hora < "12:00")) then
        saudacao = "Bom Dia"
    elseif ((hora >= "12:00") and (hora < "18:00")) then
        saudacao = "Boa Tarde"
    elseif ((hora >= "18:00") and (hora < "24:00")) then
        saudacao = "Boa Noite"
    elseif ((hora >= "00:00") and (hora < "06:00")) then
        saudacao = "Boa Madrugada"
    end if


    objShell.Popup saudacao & "  '" & strUsuario & "'" & Chr(13) & Chr(13) & _
            "Você foi logado(a) com sucesso em '" & strNomeMaquina & "'", _
            0,"Bom Serviço",vbOKOnly + vbInformation




    '****************Incio das funcoes**********************


    Sub remover_mapeamento_impressoras()
        On Error Resume Next
        Dim oPrinters,i   
        Set oPrinters = ImpNet.EnumPrinterConnections 'Pega todas as impressoras do PC
        For i = 0 to oPrinters.Count - 1 Step 2 'Verifica uma por uma
            If Left(oPrinters.Item(i+1),2) = "\\" Then 'Se for impressora mapeada
                ImpNet.RemovePrinterConnection oPrinters.Item(i+1),True,True 'Apaga
                If Err.Number<>0 Then Tratar_Erro "remover_mapeamento_impressoras()",oPrinters.Item(i+1)
            End If
         Next
    End Sub


    Sub remover_mapeamento_unidades_rede()
        On Error Resume Next   
        Dim oMap,i   
        Set oMap = ImpNet.EnumNetworkDrives 'Lista todas as unidades de rede
        For i = 0 to oMap.Count - 1 Step 2 'Verifica uma por uma
            If (oMap.Item(i) <> "") Then ImpNet.RemoveNetworkDrive oMap.Item(i),True, True 'Remove o mapeamento atual
            If Err.Number<>0 Then Tratar_Erro "remover_mapeamento_unidades_rede()",oMap.Item(i)
        Next
    End Sub


    Sub mapear_tudo()
        On Error Resume Next
        Dim objFSO,objTextFile,strLinha,arrColunas,intPosDepto,intPosUsuario,objFile,sigesShell
        Dim localMaquina,ip,compartilhamento,i,tamanhoArray,deptos,intPosDefault,intPosOs, intPosMaquina

        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objTextFile = objFSO.OpenTextFile(strPath & "configuracao.txt", 1)

        objTextFile.Readline
        Do Until objTextFile.AtEndOfStream
            strLinha = objTextFile.Readline
            arrColunas = Split(strLinha , ";")
            localMaquina = Trim(arrColunas(0))
            letra = Trim(arrColunas(1))
            maquina = Trim(arrColunas(2))
            ip = Trim(arrColunas(3))
            compartilhamento = Trim(arrColunas(4))
            deptos = "  " & Trim(arrColunas(5)) & ","
            intPosDepto = InStr(deptos ,strDepartamento & ",")
            intPosUsuario = InStr(deptos ,strUsuario & ",")
            intPosMaquina = InStr(deptos ,strNomeMaquina & ",")


            If ((localMaquina = strLocalMaquina) And _
                    ((intPosDepto>0) Or (intPosUsuario>0) Or (intPosMaquina>0) Or (Trim(arrColunas(5))="*")) ) Then
                       
                If (strNomeMaquina = maquina) Then
                     If (Len(letra)>1) Then
                        intPosOs = InStr(Mid(deptos,intPosDepto-2,2),"&")
                        If (intPosOs > 0) then
                            'objShell.RegDelete "HKCU\Software\VB and VBA Program Settings\saned\impressoras\os",letra,"REG_SZ"
                            'objShell.RegWrite "HKCU\Software\VB and VBA Program Settings\saned\impressoras\os",letra,"REG_SZ"
                        End If
                    End If
                Else
                    If (Len(letra)=1) Then
                        mapeamentos = mapeamentos & CHR(13) & letra & " | " & maquina & " | " & ip & " | " & compartilhamento
                        mapear_rede letra, "\\" & ip & "\" & compartilhamento
                    ElseIf (strOS = "NT") then
                        impressoras = impressoras & CHR(13) & letra & " | " & compartilhamento & " | " & maquina & " | " & ip
                       
                        intPosDefault = 0
                        intPosOS = 0
                        if (intPosDepto > 0) then
                            intPosDefault = InStr(Mid(deptos,intPosDepto-2,2),"#")
                            intPosOs = InStr(Mid(deptos,intPosDepto-2,2),"&")
                        end if

                        if (intPosUsuario > 0) then
                            intPosDefault = InStr(Mid(deptos,intPosUsuario-2,2),"#")
                            intPosOs = InStr(Mid(deptos,intPosUsuario-2,2),"&")
                        end if

                        if (intPosMaquina > 0) then
                            intPosDefault = InStr(Mid(deptos,intPosMaquina-2,2),"#")
                            intPosOs = InStr(Mid(deptos,intPosMaquina-2,2),"&")
                        end if
                       
                        If Err.Number<>0 Then Tratar_Erro "mapear_tudo() -> Erro no MID ","\\" & ip & "\" & compartilhamento   
                       
                        ImpNet.AddWindowsPrinterConnection "\\" & ip & "\" & compartilhamento
                        If Err.Number<>0 Then Tratar_Erro "mapear_tudo() -> AddWindowsPrinterConnection","\\" & ip & "\" & compartilhamento   

                        if  (intPosDefault > 0) Then
                            impressoras = impressoras & "  => 'PADRAO'"
                            ImpNet.SetDefaultPrinter "\\" & ip & "\" & compartilhamento
                            If Err.Number<>0 Then Tratar_Erro "mapear_tudo() -> SetDefaultPrinter","\\" & ip & "\" & compartilhamento
                        End If
       
                        If  (intPosOs > 0) Then
                            impressoras = impressoras & "  => 'OS'"
                            'objShell.RegDelete "HKCU\Software\VB and VBA Program Settings\saned\impressoras\os","\\" & ip & "\" & compartilhamento,"REG_SZ"
                            'objShell.RegWrite "HKCU\Software\VB and VBA Program Settings\saned\impressoras\os","\\" & ip & "\" & compartilhamento,"REG_SZ"
                            If Err.Number<>0 Then Tratar_Erro "mapear_tudo() -> SetOS","\\" & ip & "\" & compartilhamento
                        End If
                    End If
                End If
                If Err.Number<>0 Then Tratar_Erro "mapear_tudo()","\\" & ip & "\" & compartilhamento
            End If
           
        Loop

    End Sub


    sub mapear_rede(ByVal drive , ByVal local )
        On Error Resume Next
        drive = drive + ":"
        'ImpNet.RemoveNetworkDrive DRIVE,True,True
        ImpNet.MapNetworkDrive drive,local
        If Err.Number<>0 Then Tratar_Erro "mapear_rede()" , "'" & drive & local & "'"
       
    End Sub


    Sub definir_imagem_desktop(ByVal arquivoConfiguracao)
        On Error Resume Next
        Dim objFSO
        Const OverwriteExisting = True
        Set objFSO = CreateObject("Scripting.FileSystemObject")

        If objFSO.FileExists("C:\ferrari.jpg")=FALSE Then
            If objFSO.FolderExists("C:\temp=")=FALSE Then objFSO.CreateFolder("C:\temp")
            objFSO.CopyFile strPath & "ferrari.jpg" , "c:\", OverwriteExisting
        End If
        objShell.Run  """" & strPath & "Bginfo.exe """ & " """ & strPath & arquivoConfiguracao & """ /accepteula /silent /timer:00",0
        'Executa o arquivo "Bginfo" com os parametros "DefaultCB.bgi /silent /timer:00"
        'o parametro "0" eh da funcao "Run" e serve para naum mostrar nada para o usuario
        If Err.Number<>0 Then Tratar_Erro "definir_imagem_desktop()","Execucao BGINFO"
    End Sub


    Sub Tratar_Erro(funcao , argumento)
        Dim objFSO,objFile,descricaoErro,strPath
        Const ForReading = 1
        Const ForWriting = 2
        Const ForAppending = 8
        descricaoErro = Replace(Err.Description,Chr(13) & Chr(10),"")
        'WScript.Echo "Erro numero: " & Err.Number & Chr(13) & "Mensagem: " & argumento & Chr(13) & _
        '    "Descricao do erro: " & descricaoErro & Chr(13) & "Local gerado: " & Err.Source    & chr(13) & funcao
       
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFile = objFSO.OpenTextFile("\\192.168.1.150\ErroLogon\Logs_Erro.txt",ForAppending, TRUE)
        objFile.WriteLine(FormatDateTime(Now(),0) & _
                        " ; "& strLocalMaquina & " ; " & strNomeMaquina & " ; " & strUsuario & " ; " & _
                        Err.Number  & " ; " & funcao & " ; " & argumento & " ; " & descricaoErro & " ; " & Err.Source)
        objFile.Close

        'MsgBox Err.Number & Chr(13) & -2147023095
        If Err.Number = -2147023095 Then
            'MsgBox "Teste"
            objShell.Popup "Nao foi possivel adicionar a impressora '" & letra & "'" & Chr(13) & _
            "Favor verificar se a maquina '" & maquina & "' esta ligada" & Chr(13) & _
            "Fazer o logoff e logon apos a maquina estar ligada",0,"ERRO: MAQUINA '" & maquina & "' DESLIGADA", vbCritical
           
        End If

        Err.Clear   
    End Sub

     

     

     

    Agradeço por Qualquer ajuda!!!

    domingo, 25 de julho de 2010 13:41