Question : Vbs script to be changed into an excel macro. Can anyone help on this.

Hi,

Vbs script to be changed into an excel macro. Can anyone help on this.
The scfript checks each machine name in the txt file and gets the password reset date into another file.

What i want now if instead of the script taking the machine names from the txt file i want it to take it from colum "Q" cells
from row 3 and then results to a colum "DE"

Can anyone help please.

Regards
Sharath

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:

           
           
             Const ForAppending = 8
Const ForReading = 1
 
Set fso=CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("C:\pass_changed.txt")
Set objNetwork = CreateObject("Wscript.Network")
 
Set objFile=fso.OpenTextFile("C:\computers.txt", ForReading)
 
Do Until objFile.atEndofStream
     strComputer = objFile.ReadLine
    
Set objUser = GetObject("WinNT://" & strComputer & "/administrator")
 
intPasswordAge = objUser.PasswordAge
intPasswordAge = intPasswordAge * -1 
dtmChangeDate = DateAdd("s", intPasswordAge, Now)
 
objTextFile.WriteLine "Password for " & strComputer & " was last changed: " & dtmChangeDate
Loop

           
         

Open in New Window Select All

Answer : Vbs script to be changed into an excel macro. Can anyone help on this.

Sharath,

Pls try this - I though you wanted the time part removed when you said just the date :)

Plus some of you "empty" cells must contain text (I tested for empty) , this version looks to remove any spaces

Cheers

Dave

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:

           
           
             Sub GeEm()
    Dim rng1 As Range, c As Range, objUser
    Dim intPasswordAge, dtmChangeDate As Date
    Set rng1 = Range([q3], Cells(Rows.Count, "Q").End(xlUp))
    Application.ScreenUpdating = False
    On Error Resume Next
 
    For Each c In rng1
        If Replace(c.Value, " ", vbNullString) <> vbNullString Then
            If Ping(c.Value) Then
                Set objUser = GetObject("WinNT://" & c.Value & "/administrator")
                intPasswordAge = objUser.PasswordAge
                intPasswordAge = intPasswordAge * -1
                dtmChangeDate = DateAdd("s", intPasswordAge, Now)
                If objUser Is Nothing Then
                    Cells(c.Row, "DE") = "Permission error"
                Else
                    Cells(c.Row, "DE") = Format(dtmChangeDate, "dd-mmm-yyyy")
                End If
                Set objUser = Nothing
            Else
                Cells(c.Row, "DE") = "off"
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
 
Function Ping(strComputer)
    Dim objShell, boolCode
    Set objShell = CreateObject("WScript.Shell")
    boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
    If boolCode = 0 Then
        Ping = True
    Else
        Ping = False
    End If
End Function
           
         

Open in New Window Select All