'===================================== ' '* Name: Ward Map App - modified from ASP to run on windows clients '* Author: Kevin Ball '===================================== Dim pFile Dim arrLastName(500) Dim arrFirstNames(500) Dim arrFullName(500) 'Dim arrCity(500) 'Dim arrState(500) Dim arrPhone(500) Dim arrEmail(500) Dim arrAddr1(500) Dim arrAddr2(500) Dim arrAddr3(500) Dim arrAddr4(500) Dim arrName1(500) Dim arrName2(500) Dim currentRecordNums result = MsgBox ("Before running this script, you must download your ward's membership file from LDS.org. This script will ask you to locate your ward's LDS.org membership file that you downloaded from your unit's website. Once you select the membership csv file, the script will generate an HTML file that will display your Ward Map. Please note: you must be connected to the Internet for this to work.", vbOKCancel+vbInformation, "Ward Map Script") 'user cancelled -- end script If result = 2 Then WScript.Quit End if 'this only works on Windows XP, so comment it out if you're not on XP... Set objDialog = CreateObject("UserAccounts.CommonDialog") objDialog.Filter = "Membership Files|*.csv" objDialog.InitialDir = "C:\" intResult = objDialog.ShowOpen If intResult = 0 Then Wscript.Quit Else pFile = objDialog.FileName End If 'uncomment the line below if you're NOT running this on an XP system 'pFile = MaskedInput("Locate your LDS.ORG membership file", "Locate Ward's Membership File") ShowMap(pFile) '----------------------------------------------------------------------------------- Function MaskedInput(strCaption, strMessage) Dim objFSO, tsHTM, objIE Dim strPassword 'Create Objects Set objFSO = CreateObject("Scripting.FileSystemObject") Set objIE = WScript.CreateObject ("InternetExplorer.Application", "IE_") 'Create User Interface Set tsHTM = objFSO.OpenTextFile("C:\USERPASS.HTM", 2, -2) tsHTM.WriteLine "" & strCaption & "" tsHTM.WriteLine "" tsHTM.WriteLine "
" tsHTM.WriteLine strMessage tsHTM.WriteLine "
" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "
" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.Close 'Show Dialog objIE.Navigate "file:///C:\USERPASS.HTM" objIE.ToolBar = 0 objIE.StatusBar = 0 objIE.Width = 500 objIE.Height = 200 objIE.Left = 0 objIE.Top = 0 objIE.Visible = 1 Do While (objIE.Document.All.OKClicked.Value = "") Wscript.Sleep 250 Loop strPassword = objIE.Document.All.membershipFile.Value objIE.Quit Wscript.Sleep 250 'Clean Up objFSO.DeleteFile "C:\USERPASS.HTM", True 'Return Value MaskedInput = strPassword 'Clear Memory Set objFSO = Nothing Set tsHTM = Nothing Set objIE = Nothing End Function '----------------------------------------------------------------------------------- Sub ShowMap(strCaption) 'declare our variables Dim tsHTM, objIE Dim objFSO , strURL , objFile, tmpFile, modDate Dim strRecord, arrRecord, maxNum currentRecordNum = 0 'create an instance of the file system object Set objFSO = CreateObject("Scripting.FileSystemObject") 'this is the csv file downloaded from LDS.org strURL = strCaption 'open the file Set objFile = objFSO.OpenTextFile(strURL) Set tmpFile = objFSO.GetFile(strURL) 'Read the modification date of the file modDate = tmpFile.DateCreated Set tmpFile = Nothing 'For use if we ever have to deal with line breaks within a record (MIS likes to do this) 'text = Replace(objFile.ReadAll,chr(13)&chr(10),"

") 'strInternalBreak = "||||" 'text = Replace(text,chr(10),strInternalBreak) 'Response.write text 'response.end 'I don't want to see any errors at this point: On Error resume Next 'while we are not at the end of the file Do While Not objFile.AtEndOfStream strRecord = objFile.readLine 'Only process a line if the record starts with a quote If Left(strRecord,1) = chr(34) Then 'Response.write currentRecordNum & ":" & strRecord & "
" 'split the strText arrRecord = split(strRecord, chr(34) & "," & chr(34)) 'find max number of people on this record maxNum = UBound(arrRecord) 'Response.write "HI: " & currentRecordNum & "|" & arrRecord(0) & "
" 'Replace quotation marks and single quotes appropriately - DOWNLOAD FROM LDS SITE arrFullName(currentRecordNum) = Replace(Trim(Replace(arrRecord(0),chr(34),"")),chr(39),"\'") arrLastName(currentRecordNum) = Left(arrFullName(currentRecordNum),Instr(arrFullName(currentRecordNum),",")-1) arrFirstNames(currentRecordNum) = Right(arrFullName(currentRecordNum),Len(arrFullName(currentRecordNum))-(Len(arrLastName(currentRecordNum))+1)) arrPhone(currentRecordNum) = Replace(Trim(Replace(arrRecord(1),chr(34),"")),chr(39),"\'") arrAddr1(currentRecordNum) = Replace(Trim(Replace(arrRecord(2),chr(34),"")),chr(39),"\'") 'street arrAddr2(currentRecordNum) = Replace(Trim(Replace(arrRecord(3),chr(34),"")),chr(39),"\'") 'addr2 arrAddr3(currentRecordNum) = Replace(Trim(Replace(arrRecord(4),chr(34),"")),chr(39),"\'") 'addr3 arrAddr4(currentRecordNum) = Replace(Trim(Replace(arrRecord(5),chr(34),"")),chr(39),"\'") 'addr4 arrName1(currentRecordNum) = Replace(Trim(Replace(arrRecord(6),chr(34),"")),chr(39),"\'") 'see if an email address is contained in a name record, if so, extract it and add it to this record's email array If Instr(arrName1(currentRecordNum),"@") <> 0 Then 'get email between brackets startEmail = Instr(arrName1(currentRecordNum),"<")+1 endEmail = Instr(arrName1(currentRecordNum),">") emailLength = endEmail - startEmail thisEmail = Mid(arrName1(currentRecordNum),startEmail,emailLength) arrEmail(currentRecordNum) = Trim(thisEmail) End if 'grab rest of name info For i = 7 to maxNum thisStr = Replace(Trim(Replace(arrRecord(i),chr(34),"")),chr(39),"\'") arrName2(currentRecordNum) = arrName2(currentRecordNum) & "
" & thisStr 'see if an email address is contained in a name record, if so, extract it and add it to this record's email array If Instr(thisStr,"@") <> 0 Then 'get email between brackets startEmail = Instr(thisStr,"<")+1 endEmail = Instr(thisStr,">") emailLength = endEmail - startEmail thisEmail = Mid(thisStr,startEmail,emailLength) If arrEmail(currentRecordNum) <> "" Then arrEmail(currentRecordNum) = arrEmail(currentRecordNum) & ", " & Trim(thisEmail) Else arrEmail(currentRecordNum) = Trim(thisEmail) End if End if Next currentRecordNum = currentRecordNum + 1 End if Loop 'close and destroy objects objFile.Close Set objFile = Nothing Set objFSO = Nothing 'Create Objects Set objFSO = CreateObject("Scripting.FileSystemObject") Set objIE = WScript.CreateObject ("InternetExplorer.Application", "IE_") 'Create User Interface Set tsHTM = objFSO.OpenTextFile("C:\WARDMAP.HTM", 2, -2) tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "Ward Map - Authorized Church Use Only [last load of map data: " & modDate & "]" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine "
by Kevin Balltoggle control barC:\WARDMAP.HTM
" tsHTM.WriteLine "" tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine "
" tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine "
   print mapsave map   
" tsHTM.WriteLine "

Ward Map: Authorized use only

" tsHTM.WriteLine " " tsHTM.WriteLine "
" tsHTM.WriteLine " Find a member: " tsHTM.WriteLine " " tsHTM.WriteLine "
" tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine " " tsHTM.WriteLine "
phone:
email:
address:
" tsHTM.WriteLine "
" tsHTM.WriteLine "
" tsHTM.WriteLine "
Note: " tsHTM.WriteLine "
    " tsHTM.WriteLine "
  • This is a dynamic map! Click " tsHTM.WriteLine " and drag it to move around and see all the markers!
    • " tsHTM.WriteLine "
  • It takes a minute or two for the various " tsHTM.WriteLine " servers involved to get all of the members on the map, so please be " tsHTM.WriteLine " patient.
    • " tsHTM.WriteLine "
  • You must be connected to the Internet to use the " tsHTM.WriteLine " map.
    • " tsHTM.WriteLine "
  • You must have Flash " tsHTM.WriteLine " installed to view the map.
    • " tsHTM.WriteLine "
  • If a house does not show up, it is possible that " tsHTM.WriteLine " the address in the MIS is incorrect or that Yahoo does not yet have " tsHTM.WriteLine " the street in its database.
    • " tsHTM.WriteLine "
  • Press F11 to view in FullScreen (IE)
    • " tsHTM.WriteLine "
" tsHTM.WriteLine "
" tsHTM.WriteLine " >
" tsHTM.WriteLine " <
" pMapCenterAddress = arrAddr1(0) & ", " & arrAddr2(0) & ", " If arrAddr3(0)<>"Tx" Then pMapCenterAddress = pMapCenterAddress & arrAddr3(0) End if pMapCenterAddress = pMapCenterAddress & arrAddr4(0) tsHTM.WriteLine "" tsHTM.WriteLine "" tsHTM.WriteLine " " tsHTM.Close 'Show Dialog strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery _ ("Select * From Win32_DisplayConfiguration") objIE.Navigate "file:///C:\WARDMAP.HTM" objIE.ToolBar = 0 objIE.StatusBar = 1 For each objItem in colItems objIE.Width = objItem.PelsWidth objIE.Height = objItem.PelsHeight Next objIE.Left = 0 objIE.Top = 0 objIE.Visible = 1 set objWMIService = Nothing set colItems = Nothing Wscript.Sleep 250 'Clean Up 'objFSO.DeleteFile "C:\WARDMAP.HTM", True 'Clear Memory Set objFSO = Nothing Set tsHTM = Nothing Set objIE = Nothing End Sub Public Function showDetails(pNum) strReturn = "" If Trim(arrAddr1(pNum)) <> "" Then strReturn = strReturn & Trim(arrAddr1(pNum)) & " " End if If Trim(arrAddr2(pNum)) <> "" Then strReturn = strReturn & Trim(arrAddr2(pNum)) & " " End if If Trim(arrAddr3(pNum)) <> "" Then strReturn = strReturn & Trim(arrAddr3(pNum)) & " " End if If Trim(arrAddr4(pNum)) <> "" Then strReturn = strReturn & Trim(arrAddr4(pNum)) End if strReturn = Trim(strReturn) If Trim(arrPhone(pNum)) <> "" Then strReturn = strReturn & "
" & arrPhone(pNum) End if If Trim(arrName1(pNum)) <> "" Then strReturn = strReturn & "
" & arrName1(pNum) End if If Trim(arrName2(pNum)) <> "" Then strReturn = strReturn & arrName2(pNum) End if showDetails = strReturn End Function