AboutPricingCommunityTeamsStart Free TrialLog in
Avatar of winstalla
winstalla
Flag for United Kingdom of Great Britain and Northern Ireland asked on

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!
VB ScriptHTML
Avatar of undefined
Last Comment
RobSampson
8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
RobSampson
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
David Johnson, CD
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

winstalla
ASKER
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

winstalla
ASKER
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!
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
RobSampson
Lol! I'm sure we've all done that at some point! No problem, glad to help.
Plans and Pricing
Resources
Product
Podcasts
Careers
Contact Us
Teams
Certified Expert Program
Credly Partnership
Udemy Partnership
Privacy Policy
Terms of Use

© 1996-2023 Experts Exchange, LLC. All rights reserved. Covered by US Patent