VB HTA File Copy by Group

I have a VB/HTA login script that is nearly working. However, I want to be able to copy a file from a network share based on an AD Group. I've managed to get it to create shortcuts based on AD, but not this.

Here is the code I'm trying:-
Const bgGroup1 = "ADgroup1"
Const bgFolder1 = "C:\BG\", bgFile1 = "\\DOMAIN\netlogon\bg\file1*"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(bgFolder1) Then
  oFSO.CreateFolder bgFolder1
End If
oFSO.CopyFile bgFile1, bgFolder1, Overwrite

Const bgGroup2 = "ADgroup2"
Const bgFolder2 = "C:\BG\", bgFile2 = "\\DOMAIN\netlogon\bg\file2*"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(bgFolder2) Then
  oFSO.CreateFolder bgFolder2
End If
oFSO.CopyFile bgFile2, bgFolder2, Overwrite

Open in new window


It sounds simple, but all it does is copy both File1 and File2 to the machine, which is obviously not what I'm looking for.

To explain, the FileX.bmp file will be renamed later to a standard BG.bmp file for use with BGInfo. That bit's working! It's just this  bit I'm having problems with.

Any help would be gratefully received.

Thanks!
winstallaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RobSampsonCommented:
Hi, try this code.

Regards,

Rob.

' THIS LINE MUST BE PLACED IN THE MAIN CODE TO ALLOW THE DICTIONARY
' OBJECT TO REMAIN PERSISTENT FOR THE ISMEMBEROFGROUP FUNCTION
Dim objMemberships

Set objNetwork = CreateObject("WScript.Network")
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objADSysInfo.UserName)

Const bgGroup1 = "ADgroup1"
Const bgFolder1 = "C:\BG\"
Const bgFile1 = "\\DOMAIN\netlogon\bg\file1*"

Const bgGroup2 = "ADgroup2"
Const bgFolder2 = "C:\BG\"
Const bgFile2 = "\\DOMAIN\netlogon\bg\file2*"

Set oFSO = CreateObject("Scripting.FileSystemObject")

If IsMemberOfGroup(objUser, bgGroup1) = True Then
	If Not oFSO.FolderExists(bgFolder1) Then
		oFSO.CreateFolder bgFolder1
	End If
	oFSO.CopyFile bgFile1, bgFolder1, Overwrite
End If

If IsMemberOfGroup(objUser, bgGroup2) = True Then
	If Not oFSO.FolderExists(bgFolder2) Then
		oFSO.CreateFolder bgFolder2
	End If
	oFSO.CopyFile bgFile2, bgFolder2, Overwrite
End If

Function IsMemberOfGroup(objADUser, strGroupCN)
	If IsEmpty(objMemberships) = True Then
		Set objMemberships = CreateObject("Scripting.Dictionary")
		objMemberships.Add LCase("ALL"), 0
		If IsNull(objADUser.MemberOf) = False Then
			If TypeName(objADUser.MemberOf) = "String" Then
				objMemberships.Add LCase(Mid(Split(objADUser.MemberOf, ",")(0), 4)), 0
			Else
				For Each strGroupName In objADUser.MemberOf
					objMemberships.Add LCase(Mid(Split(strGroupName, ",")(0), 4)), 0
				Next
			End If
		End If
	End If
	If objMemberships.Exists(LCase(strGroupCN)) = True Then
		IsMemberOfGroup = True
	Else
		IsMemberOfGroup = False
	End If
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
David Johnson, CD, MVPOwnerCommented:
this is powershell and handles groups
$user = $env:USERNAME
$Group = @()
$info = @{
    'Group' = "ADGroup1"
    "Source" = "\\DOMAIN\netlogon\bg\file1.bmp"
    }
$Group = New-Object -TypeName psobject -Property $Info
$info = @{
    'Group' = "ADGroup2"
    "Source" = "\\DOMAIN\netlogon\bg\file2.bmp"
    }
$Group2 = New-Object -TypeName psobject -Property $Info
$Group = [array]$Group + $Group2
$tocopy = "\\DOMAIN\netlogon\bg\BGFILEDefault.bmp"
foreach($group in $Groups){
if ((Get-ADUser $User -Properties memberof).memberof -like "CN=" + $group.Group)
    {
    $tocopy = $group.source
    break
    }
}
$bgFolder = "C:\BG\"
if (!(test-path $bgFolder)) {
    md $bgFolder
    }
copy-item $tocopy -Container $bgFolder -Include $tocopy -Force
rename-item $tocopy bginfo.bmp

Open in new window

0
winstallaAuthor Commented:
Rob,

I tried your suggestion, but it didn't copy anything - including files that had happily copied previously.

David,

How would I put this into a VB or HTA script?

I have copied the whole code (prior to the updates from Rob which have been redacted) in case something further down (or up) is causing the issue.
<!-- 
  Logon Script - logon.hta  
  Created by ME
   Version 1.0
--> 
 
<head> 
<title></title> 
 
<script language="VBScript"> 
    'Prevent Window flickering on load. 
    Me.ResizeTo 500,378 
    'Move Window off screen. 
    Me.MoveTo ((Screen.Width)),((Screen.Height)) 
</script> 
 
<HTA:APPLICATION 
     APPLICATIONNAME="LogonScript" 
     BORDER="thin" 
     BorderStyle="complex" 
     SCROLL="no" 
     maximizebutton="no" 
       minimizebutton="no"        
       SINGLEINSTANCE="yes" 
     WINDOWSTATE="normal" 
     SysMenu="no" 
     ContextMenu="no" 
     Icon="C:\[FOLDER]\logon.ico"
> 
</head> 
 
<script language="VBScript"> 
 
Dim FSO, oShell, oNetwork, objSysInfo, sUserDN, objUser 
Dim sDepartment, sUserName, sComputerName, sDomain, sDisplayName, sGroups, sDN 
Dim sStatus, intSeconds, sDesktop, sScriptDir, iTimerID 
 
'Configure for your domain. See "MainScript" Sub for drive mappings. 
sDN = "[DOMAIN].local" 
 
Sub Window_onLoad 
    On Error Resume Next 
     
    Set FSO = CreateObject("Scripting.FileSystemObject") 
    Set oShell = CreateObject("WScript.Shell") 
    Set oNetwork = CreateObject("WScript.Network") 
      
    'Get User's information. 
    UserInfo 
     
    'User's Desktop for deploying shortcuts. 
    sDesktop = oShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\" 
     
    'Populate Window with user info. 
    document.title = sDomain & " Logon Script - " & sDepartment 'Changes title bar to reflect domain and department the current user is logging onto. 
    DisplayName.InnerHTML = sDisplayName 
    UserName.InnerHTML = sUserName 
    ComputerName.InnerHTML = sComputerName 
     
    'Repl[FOLDER] logo with Dept. logo if found. 
    HTA = location.pathname 
    HTA_Path = Left(HTA,InStrRev(HTA,"\")) 
     
    'Repl[FOLDER] logo with Dept logo if found. Pl[FOLDER] department logo in same dir as logon.hta. Name should be logo-department.gif, where department is the OU name. 
    If FSO.FileExists(HTA_Path & "logo-" & sDepartment & ".gif") Then 
        Logo.src = "logo-" & sDepartment & ".gif" 
    Else 
        Logo.src = "logo-default.gif" 
    End If 
     
    'Move to top left of screen. 
    Me.MoveTo 100,100 
     
    'Run Main Logon Script 
    MainScript 
     
    'Countdown timer before closing. Set time in seconds. 
    intSeconds = 3 
    iTimerID = window.setInterval("Count", 1000) 
End Sub 
 
Sub Default_Buttons 
    If Window.Event.KeyCode = 13 Then 
    End If 
End Sub 
 
Sub UserInfo 
    On Error Resume Next 
     
    Dim arrDept 
     
    Set objSysInfo = CreateObject("ADSystemInfo") 
     
    sUserDN = objSysInfo.UserName 
    Set objUser = GetObject("LDAP://" & sDN & "/" & sUserDN) 
     
    'Find User and Computer info. 
    sUserName = oNetwork.UserName 
    sComputerName = UCase((oNetwork.ComputerName)) 
    sDomain = UCase((oNetwork.UserDomain)) 
    sDisplayName = trim(objUser.DisplayName) 
     
    'Find Group Memberships 
    sGroups = GetGroups(sUserDN) 
     
    'Get department name from DN. (Assuming users OU in AD is setup as Domain->Department->Users->UserObject) 
    arrDept = split(sUserDN, ",") 
    sDepartment = mid(arrDept(2), 4) 'Set number in array where department OU name is found.  
                                    'ie: CN=UserName,OU=Users,OU=Department,DC=your,DC=domain,DC=com; arrDept(2) = OU=Department 
     
    'If Full Name isn't found, set as username. 
    If sDisplayName = "" Then 
        sDisplayName = sDisplayName 
    End If 
     
    Err.Clear 
     
    Set objSysInfo = Nothing 
    Set objUser = Nothing 
End Sub 
 
'=======================================================================
Sub MainScript 

On Error Resume Next

objExplorer.Visible = 1             
' *****Change Mouse Cursor, Set Window Title *****
objExplorer.Document.Body.Style.Cursor = "wait"

' *****Window Message, Hourglass icon, 1 Second pause *****
ShowStat ("Logon script running. This may take me a few moments. Meanwhile, please be mesmerised by the snazzy little picture above! Oooh! Shiny!")

' *****Object to run SHELL Commands *****
Set objShell = WScript.CreateObject("WScript.Shell")
Set WSHShell = CreateObject("WScript.Shell")
Set WSHNetwork = CreateObject("WScript.Network")
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strFullName = objUser.Get("displayName")
' ***** Grab User Name and Domain Name *****
DomainString = Wshnetwork.UserDomain 
' ***** Find the Windows Directory *****
WinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")
' ***** Grab the user name *****
UserString = strFullName
' ***** Bind to the user object to get user name and check for group memberships later *****
Set UserObj = GetObject("WinNT://" & DomainString & "/" & UserString)
' ***** Grab the computer name for use in add-on code later *****
strComputer = WSHNetwork.ComputerName

' ***** Find if C:\[FOLDER] exists and create it if not. Copy Updated files from [FOLDER] DC to C:\[FOLDER] *****
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat ("I am copying any Updated Files from the Server. Please wait a moment....")
ShowStat (" ")
ShowStat ("Logon script running. This may take me a few moments. Meanwhile, please be mesmerised by the snazzy little picture above! Oooh! Shiny!")
Const strFolder = "C:\[FOLDER]\", strFile = "\\[DOMAIN].local\netlogon\[FOLDER]\*.*"
Const Overwrite = True
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(strFolder) Then
  oFSO.CreateFolder strFolder
End If
oFSO.CopyFile strFile, strFolder, Overwrite

'
' ================================================
'  Copies Background file dependent on Group
'
Const bgGroup1 = "gpo_[COMPANY2]_background"
Const bgFolder1 = "C:\[FOLDER]\", bgFile1 = "\\[DOMAIN].local\netlogon\[FOLDER]\backgrounds\[COMPANY2]*"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(bgFolder1) Then
  oFSO.CreateFolder bgFolder1
End If
oFSO.CopyFile bgFile1, bgFolder1, Overwrite

Const bgGroup2 = "gpo_[COMPANY]_background"
Const bgFolder2 = "C:\[FOLDER]\", bgFile2 = "\\[DOMAIN].local\netlogon\[FOLDER]\backgrounds\[COMPANY]*"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(bgFolder2) Then
  oFSO.CreateFolder bgFolder2
End If
oFSO.CopyFile bgFile2, bgFolder2, Overwrite



' ***** Create Desktop Shortcuts *****
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat ("I am checking for, and creating your personal Desktop Shortcuts. Give me a few seconds, please...")
ShowStat (" ")
ShowStat ("I am copying any Updated Files from the Server. Please wait a moment....")
ShowStat (" ")
ShowStat ("Logon script running. This may take me a few moments. Meanwhile, please be mesmerised by the snazzy little picture above! Oooh! Shiny!")

' ================== Delete Old Shortcuts =============================
Set Shell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
DesktopPath = Shell.SpecialFolders("Desktop")
FSO.DeleteFile DesktopPath & "\intranet.url"
FSO.DeleteFile DesktopPath & "\[APPLICATION] Online.lnk"
FSO.DeleteFile DesktopPath & "\[APPLICATION].lnk"
FSO.DeleteFile DesktopPath & "\[APPLICATION].lnk"
FSO.DeleteFile DesktopPath & "\[APPLICATION] Queries and Reports Menu.lnk"
FSO.DeleteFile DesktopPath & "\Company.lnk"
FSO.DeleteFile "C:\[FOLDER]\bg.bmp"

' To Delete a file from within C:\[FOLDER] that is no longer required, uncomment and modify the below - works as normal User
' FSO.DeleteFile "C:\[FOLDER]\FILENAME"

' ================== Create New Shortcuts =============================
SET oFSO = Wscript.CreateObject("Scripting.FileSystemObject")
	strDsk = WshShell.SpecialFolders("Desktop")

	
' ***** Code to create a specific shortcut *****
Dim objNetwork, objUser, CurrentUser, strDesktop
Dim strGroup, oShellLink

'
' ================================================
'  Configure
'
Const userGroup1 = "sc_laptop_users"
Const userGroup2 = "sc_[APPLICATION]"
Const userGroup3 = "sc_[WEB APPLICATION]"
Const userGroup4 = "sc_[APPLICATION]"
Const userGroup5 = "sc_intranet"
' ================================================

' Create objects and extract strGroup values
Set objNetwork = CreateObject("WScript.Network")
Set objUser = CreateObject("ADSystemInfo")
Set CurrentUser = GetObject("LDAP://" & objUser.UserName)
strGroup = LCase(Join(CurrentUser.MemberOf))

set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")

' Assign shortcuts

' == Laptop Users ====================================
If InStr(strGroup, lcase(userGroup1)) Then

	' Example of an Application Shortcut
	set oShellLink = WshShell.CreateShortcut(strDesktop & "\Login Offline.lnk")
	oShellLink.TargetPath = "C:\[FOLDER]\Logon.cmd"
	oShellLink.IconLocation = "C:\[FOLDER]\Logon.ico" 
	oShellLink.Description = "Login Offline"
	oShellLink.Save

	set oShellLink = WshShell.CreateShortcut(strDesktop & "\VPN.lnk")
	oShellLink.TargetPath = "C:\Program Files (x86)\Fortinet\SslvpnClient\FortiSSLVPNclient.exe"
	oShellLink.IconLocation = "%SystemRoot%\Installer\{A34DCE59-0004-0000-2267-3F8A9926B752}\FortiSSLVPNclient.ico" 
	oShellLink.Description = "VPN"
	oShellLink.Save
End If
' ================================================

' == [APPLICATION] Online =========================
If InStr(strGroup, lcase(userGroup3)) Then

	set oShellLink = WshShell.CreateShortcut(strDesktop & "\[APPLICATION] Online.lnk")
	oShellLink.TargetPath = "https://chlapps.co.uk/FosteringSolutions/[APPLICATION]online/default.asp"
	oShellLink.IconLocation = "C:\[FOLDER]\col.ico" 
	oShellLink.Description = "[APPLICATION] Online"
	oShellLink.Save
End If

' ================================================

' == [APPLICATION] ====================================
If InStr(strGroup, lcase(userGroup4)) Then

	set oShellLink = WshShell.CreateShortcut(strDesktop & "\[APPLICATION].lnk")
	oShellLink.TargetPath = "https://www.[APPLICATION]hrponline.net/index.aspx"
	oShellLink.IconLocation = "C:\Windows\System32\cmmon32.exe" 
	oShellLink.Description = "[APPLICATION]"
	oShellLink.Save
End If
' ================================================

' == Intranet ====================================
If InStr(strGroup, lcase(userGroup5)) Then

	set oShellLink = WshShell.CreateShortcut(strDesktop & "\Intranet.lnk")
	oShellLink.TargetPath = "http://192.168.77.23"
	oShellLink.IconLocation = "C:\Program Files\Internet Explorer\iexplore.exe" 
	oShellLink.Description = "Intranet"
	oShellLink.Save
End If
' ================================================

' == [APPLICATION] ====================================
If InStr(strGroup, lcase(userGroup2)) Then

	set oShellLink = WshShell.CreateShortcut(strDesktop & "\[APPLICATION].lnk")
	oShellLink.TargetPath = "C:\[FOLDER]\ARES.rdp"
	oShellLink.IconLocation = "mstsc.exe" 
	oShellLink.Description = "[APPLICATION]"
	oShellLink.Save
End If
' ================================================


' ***** Changes the desktop background file for BGInfo. *****
WshShell.Run "C:\[FOLDER]\Rename.bat"
' ***** Runs the BGInfo application to set the desktop background and display the BG information. *****
' BGInfo

' ***** Logon Script Complete. Send Completion message and close script *****
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (UserString & ", your logon script is now complete and Windows is loading up. Have a nice day!")
ShowStat (" ")
ShowStat ("I am checking for, and creating your personal Desktop Shortcuts. Give me a few seconds, please...")
ShowStat (" ")
ShowStat ("I am copying any Updated Files from the Server. Please wait a moment....")
ShowStat (" ")
ShowStat ("Logon script running. This may take me a few moments. Meanwhile, please be mesmerised by the snazzy little picture above! Oooh! Shiny!")

objExplorer.Document.Body.Style.Cursor = "default"
My.Computer.FileSystem.RenameFile "C:\[FOLDER]\Backgrounds\acornpark.bmp", "C:\[FOLDER]\bg.bmp"

End Sub 
'==========================================================================================================================================================================
'=================================================================== END OF LOGIN SCRIPT ===================================================================================
'-------------------- Functions -------------------------- 
'------------------- SLEEP -----------------------------
Sub sleep (Timesec)
    Set objwsh = CreateObject("WScript.Shell") 
    objwsh.Run "Timeout /T " & Timesec & " /nobreak" ,0 ,true
    Set objwsh = Nothing
End Sub
' example to wait for 3 seconds:
'sleep 3 

'------------------- BGINFO -----------------------------
     Sub BGInfo
	    Set objShell = CreateObject("Wscript.Shell")
        objShell.Run "C:\[FOLDER]\bginfo.exe C:\[FOLDER]\wst.bgi /accepteula /timer:0"
    End Sub
 
'----------------------- Close Window--------------------------- 
Sub CloseSelf 
    window.close 
End Sub 
 
Sub Hold 
    document.all.lock.checked = True 
    window.clearInterval(iTimerID) 
    countdown.Style.Display = "none" 
    btn_close.Style.Display = "inline" 
End Sub 

'------------------ Count -------------------------- 
Sub Count 
    'Bring script to front. 
    window.focus() 
     
    If intSeconds <> 0 Then 
        countdown.InnerHTML = intSeconds 
        intSeconds = intSeconds - 1 
    Else 
        If Not document.all.lock.checked Then 
            CloseSelf 
        End If 
    End If 
End Sub 
 
 
 '----------------------------- Get Groups --------------------
Function GetGroups(sUDN) 
    On Error Resume Next 
     
    'Function to return user's Group Memberships 
    Set objUser2 = GetObject("LDAP://" & sDN & "/" & sUDN) 
     
    If objUser2.primaryGroupID = 513 Then 
        sList = sList & "Domain Users" & VbCrLf 
    Else  
        If objUser2.primaryGroupID = 512 Then 
            sList = sList & "Domain Admins" & VbCrLf 
        End If 
    End If 
 
    oMemberOf = objUser2.GetEx("memberOf") 
 
    For Each oGroup In oMemberOf 
        oGroup = Mid(oGroup, 4, 330) 
        arrGroup = Split(oGroup, ",") 
        sList = sList & arrGroup(0) & VbCrLf 
    Next  
     
    Set objUser2 = Nothing 
     
    GetGroups = sList 
End Function 
 
'------------------------ Show Status Message (write to window) ----------------
Function ShowStat(sMessage) 
    sStatus = sMessage & VbCrLf & sStatus 
    document.all.status.InnerText = sStatus 
End Function 

'============================================== END OF FUNCTIONS! ==========================================
 
</script> 
 
<body id="mainbody" bgcolor="white" style="font:Verdana; color:black" onclick="hold"> 
    <table width="100%" border="0" cellpadding="0"> 
        <tr valign="center"> 
            <td align="center" width="30%"> 
                <img name="Logo">                     
            </td>             
            <td align="center" width="70%"> 
                <font size="3" f[FOLDER]="arial">Welcome&nbsp;<strong><span style="color:blue" id="DisplayName"></span></strong>&nbsp;<br><font size="2">to the</font><br><B><font color="blue">[FOLDER] Domain</B></font><br>
                <font f[FOLDER]="arial" size="3">Logon Name:&nbsp;<B><span style="color:blue" id="UserName"></span><BR></B>Computer Name:&nbsp;<B><span style="color:blue" id="ComputerName"></span></B> 
            </td> 
        </tr>         
        <tr> 
            <td> 
            </td>         
        </tr> 
    </table> 
    <table width="100%" border="0" cellpadding="0"> 
        <tr align="left"> 
            <td> 
                <textarea rows="15" name="status" cols="73" style="font-family: Verdana; font-weight:bold; font-size: 8pt"></textarea> 
            </td> 
        </tr> 
        <hr color="red">     
    </table>     
    <table width="100%" border="0" cellpadding="0"> 
        <tr valign="top"> 
            <td align="left" width="50%"> 
                <font size="2.25">&nbsp;</font><input type="checkbox" name="lock"> 
            </td> 
            <td align="right" width="50%"> 
                <span id="countdown"></span><input type="button" name="btn_close" style="display:none" value="Close" onclick="CloseSelf"> 
            </td> 
        </tr>     
    </table> 
</body>

Open in new window

0
winstallaAuthor Commented:
Rob's answer does work if you don't act like a blithering idiot and actually copy the files from the right place! Sorry!

And thanks, Rob!
0
RobSampsonCommented:
Lol! I'm sure we've all done that at some point! No problem, glad to help.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.