Develop Reference

How do I set Acrobat XI printer settings through excel vba?

I am designing a vba code that allows users to input a set of technical drawing numbers and create a packet from it. I have run into a problem when dealing with autocad files. Because our company has AutoCAD LT I am unable to utilize the api, thus I am using adobe's PDFMaker api to convert the files directly to pdf. Unfortunately the settings for pdfMaker are rather limited so I need to parse through the outputted pdf packet and print it in black and white (monochrome). I currently have a subroutine that opens the packet and prints the necessary pages, however, it only prints black and white if I specifically open up acrobat and select my "Monochrome" configuration in the advanced settings. Is there a way to send the command (I believe it's in javascript?) to set this color configuration and set the size option to fit? Here is my code.
Public xlBook As Workbook
Public xlSheet As Worksheet
Public LastRow As Integer
Public ItemNumber As String
Public Vin5 As String
Public Vin As String
Public FullPath As String
Sub PdfFormat()
Dim strMakeFile As String
Dim LastRow As Integer
Set xlBook = ActiveWorkbook
Set xlSheet = xlBook.Sheets(1)
ItemNumber = Range("E1")
Vin5 = Range("F1")
Vin = ItemNumber & "0" & Vin5
FullPath = "\\eastfile\Departments\Engineering\MACROS\New Packet Output\" & Vin & "\"
strMakeFile = FullPath & Vin & ".pdf"
LastRow = Range("A" & xlSheet.Rows.Count).End(-4162).Row
Dim AcroExchApp As New Acrobat.AcroApp
Dim AcroExchAVDoc As New Acrobat.AcroAVDoc
Dim AcroExchPDDoc As Acrobat.AcroPDDoc
Dim OpenError As Boolean
Dim PrintError As Boolean
OpenError = AcroExchAVDoc.Open(strMakeFile, "")
!!!!!CODE FOR PRINTER SETTINGS HERE!!!!!
PrintError = AcroExchAVDoc.PrintPagesSilentEx(0, 5, 3, 1, 1, 0, 0, 0, -5)
Debug.Print "Open Error: " & Not (OpenError)
Debug.Print "Print Error: " & Not (PrintError)
Debug.Print Vin
AcroExchApp.CloseAllDocs
End Sub
Thank you for your time

The print parameters in Acrobat you can find in the Acro-js helpfile for example here: Acro JS setting print options
With VBS/VBA there are 2 ways to use it. With the help of Acro-Form API you can execute js-code more or less direkt. Here I gave a simple example: Execute Acro js from VBA/VBS
The other way is to use the JS-Object, which lets you use transformed js-code via VBA/VBS Ole connection. That's documented in the Adobe Acrobat IAC Reference.
How that works you can see in the following example, where I use jso for setting some print parameters. Change the given print parameters to that what you need or search in the Acro JS helfile for some other example and execute it via above described way direct. Good luck, Reinhard
'// print dropped files with printParameter
set WshShell = CreateObject ("Wscript.Shell")
set fs = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
if objArgs.Count < 1 then
msgbox("Please drag a file on the script")
WScript.quit
end if
'contact Acrobat
Set gApp = CreateObject("AcroExch.App")
gApp.show 'comment or take out to work in hidden mode
'open via Avdoc and print
for i=0 to objArgs.Count - 1
FileIn = ObjArgs(i)
Set AVDoc = CreateObject("AcroExch.AVDoc")
If AVDoc.Open(FileIn, "") Then
Set PDDoc = AVDoc.GetPDDoc()
Set JSO = PDDoc.GetJSObject
jso.print false, 0, 0, true
set pp = jso.getPrintParams
pp.printerName = "hp deskjet 990c"
pp.firstPage = 0 '-> Zero based (firstPage = 0)
pp.lastPage = 5 '-> Zero based (pageCount - 1)
pp.interactive = pp.constants.interactionLevel.automatic '-> no print dialog
pp.pageHandling = pp.constants.handling.booklet
pp.booklet.duplexMode = pp.constants.bookletDuplexModes.BothSides
pp.booklet.binding = pp.constants.bookletBindings.LeftTall
jso.print(pp)
gApp.CloseAllDocs
end if
next
gApp.hide
gApp.exit
MsgBox "Done!"
Quit()
Sub Quit()
Set JSO = Nothing
Set PDDoc = Nothing
Set gApp = Nothing
Wscript.quit
End Sub

SignalR JS command doesn't execute on websockets first time (vb.net)

So when I visit my page and I set the video mode using this:
$("#pushStreamButton").click(function () {
if (initialized) {
var channelSelected = $("#channelSelect").val();
var gameNameEntered = $("#gameName").val();
var channelNameEntered = $("#channelName").val();
if (gameNameEntered.length < 1) return;
$("#goLiveWindow").dialog("close");
serverHub.server.setVideoMode(channelSelected, gameNameEntered, "", channelNameEntered);
}
});
and this is in the backend
Public Sub setVideoMode(ByVal mode As String, ByVal details As String, ByVal socialMessage As String, ByVal channel As String)
Dim user As FrontPageUser = Connections.matchFirst(Connections.frontPageUsers, Context.ConnectionId)
If user Is Nothing Then Return
If mode = "youtube" Then
Try
My.Computer.FileSystem.DeleteFile(HttpContext.Current.Server.MapPath("/images/streamavatar.gif"))
Catch Ex As Exception
Console.Write(Ex)
End Try
End If
This functions as expected, it does it's job, however I have a button that reverts the channel back to the default youtube
$("#stopStreamButton").click(function () {
serverHub.server.setVideoMode("youtube", "", "", "");
});
After changing the channel using the first button, clicking the second button doesn't do anything, it doesn't even seem to attempt to execute the command, which is bizarre. However if I reload the page the button functions correctly and the channel is reverted.
This issue also isn't present when using SSE/longpolling/foreverframe, only when using websockets as the transport. I'm treading relatively unknown waters with websockets, and I've tried debugging the javascript and the backend code - the javascript doesn't seem to execute correctly, but it doesn't spout any errors, and it never reaches the backend.
If anybody knows why this happens and could explain where I'm going wrong, it'd be appreciated.
Additional: after digging further, it actually appears to stop all functions from the java side and after a while it seems to disconnect and force a refresh, not sure what is causing it, but I know it has to be related to websockets.
edit --
Upon debugging cause, it appears to be linked to another function which sends a push notification to subscribers, when I disable this function it works without hanging and blocking commands, but when this function is initialized it hangs, seemingly after the function has completed
Shared Function sendPushFox(username, pushDetails) As String
Dim avatar = Utils.getAvatarPath(username)
If avatar.Contains("/forum/download/file.php?avatar=") OrElse avatar.Contains("/images/solaire.png") Then
Try
My.Computer.Network.DownloadFile("https://foo.com" & avatar, HttpContext.Current.Server.MapPath("/images/streamavatar.gif"))
Catch ex As Exception
ChatProcessor.postNewMessage(Nothing, Nothing, ChatMessage.MessageType.Channel_Mod, "Problem downloading streamer avatar." & ex.ToString)
End Try
Else
Try
My.Computer.Network.DownloadFile(avatar, HttpContext.Current.Server.MapPath("/images/streamavatar.gif"))
Catch ex As Exception
ChatProcessor.postNewMessage(Nothing, Nothing, ChatMessage.MessageType.Channel_Mod, "Problem downloading streamer avatar." & ex.ToString)
End Try
End If
Dim query As String = "SELECT subscribeid FROM custom_user_data WHERE NOT subscribeid = ' ';"
Dim connection As New MySqlConnection(Utils.connectionString) : connection.Open()
Dim command As MySqlCommand = New MySqlCommand(query, connection)
Dim reader As MySqlDataReader = command.ExecuteReader()
Dim regList As New List(Of String)
Do While reader.Read
regList.Add(reader.GetString(0))
' IO.File.AppendAllText(Utils.serverPath & "errorlog.txt", reg1)
Loop
connection.Close()
Dim query2 As String = "SELECT p256dh FROM custom_user_data WHERE NOT p256dh = ' ';"
Dim connection2 As New MySqlConnection(Utils.connectionString) : connection2.Open()
Dim command2 As MySqlCommand = New MySqlCommand(query2, connection2)
Dim reader2 As MySqlDataReader = command2.ExecuteReader()
Dim regList2 As New List(Of String)
Do While reader2.Read
regList2.Add(reader2.GetString(0))
' IO.File.AppendAllText(Utils.serverPath & "errorlog.txt", reg1)
Loop
connection2.Close()
Dim query3 As String = "SELECT authsecret FROM custom_user_data WHERE NOT authsecret = ' ';"
Dim connection3 As New MySqlConnection(Utils.connectionString) : connection3.Open()
Dim command3 As MySqlCommand = New MySqlCommand(query3, connection3)
Dim reader3 As MySqlDataReader = command3.ExecuteReader()
Dim regList3 As New List(Of String)
Do While reader3.Read
regList3.Add(reader3.GetString(0))
' IO.File.AppendAllText(Utils.serverPath & "errorlog.txt", reg1)
Loop
connection3.Close()
Dim reg1 = regList.ToArray
Dim reg2 = regList2.ToArray
Dim reg3 = regList3.ToArray
Dim payload = "{ ""title"": ""foo bar"", ""body"": """ & username.name.ToString & " playing " & pushDetails.ToString & """, ""icon"" : ""https://foo.com/images/streamavatar.gif"" }"
For i As Integer = 0 To reg1.Length - 1
Dim webPushClient = New WebPushClient()
Dim subject = "https://foo.com"
Dim vapidKeys As VapidDetails = VapidHelper.GenerateVapidKeys()
Dim vapidDetails = New VapidDetails(subject, vapidKeys.PublicKey, vapidKeys.PrivateKey)
Try
Console.WriteLine("Public {0}", vapidKeys.PublicKey)
Console.WriteLine("Private {0}", vapidKeys.PrivateKey)
Dim subscription = New PushSubscription(reg1(i), reg2(i), reg3(i))
webPushClient.SetGCMAPIKey("key here")
webPushClient.SendNotification(subscription, payload, vapidDetails)
Catch Ex As Exception
Console.Write(Ex)
End Try
Next
Return Nothing
End Function
So, it's a clash with websockets, since it functions on longpolling and etc but I'm still not sure why, and it only affects the user who calls the function.
Strangely enough this appears to hang after the "next" which happens here
For i As Integer = 0 To reg1.Length - 1
webPushClient.SetGCMAPIKey("key here")
webPushClient.SendNotification(subscription, payload, vapidDetails)
Next
it functions completely fine, but once it reaches the end of the for, it just never continues, it does literally nothing after Next, no errors, nothing happens, set breaks and results are as expected, I'm just baffled as to why it doesn't continue, and only using websockets trasports, longpolling and etc is fine

I actually figured this out, it turns out that websockets don't like the non asynchronous communication made from the command
webPushClient.SendNotification(subscription, payload, vapidDetails)
Fortunately the webPush lib has an async and changing it to
webPushClient.SendNotificationAsync(subscription, payload, vapidDetails)
fixed everything.

Downloading File from IE using VBA

I am currently working on a VBA code that retrieves the top file from this website (http://infopost.bwpmlp.com/Posting/default.aspx?Mode=Display&Id=27&tspid=100000). I am able to click on the button using Javascript in my code, and I am able to click on open after the download is kicked off. However, I am having trouble saving the file. Because the workbook is being pulled from a website there really isn't a way to set it to the active workbook that I can think of. Currently when I do ActiveWorkbook.SaveAs the code is saving the blank workbook that I am testing the code out of. The file I downloaded seems to not open until the entire code is done running even after I try putting in breaks. Anyone have any ideas? My code is below. Thanks!
Option Explicit
Dim ie As InternetExplorer
Dim h As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Sub Texas_Gas()
Application.DisplayAlerts = True
Dim ie As Object
Dim IeHandle As Long, FileDownloadHandle As Long, OpenButtonHandle As Long, IePopupBarHandle As Long
Dim AutoMode As Boolean, FileDownloadClassicPopup As Boolean, DownloadComplete As Boolean
Dim Timeout As Date
Dim strSPICE As String, strLink As String
Dim PopupGap As Integer, i As Integer
Set ie = CreateObject("InternetExplorer.Application")
DownloadComplete = False
FileDownloadClassicPopup = False
FileDownloadHandle = 0
IePopupBarHandle = 0
With ie
.Visible = True
.navigate "http://infopost.bwpmlp.com/Posting/default.aspx? Mode=Display&Id=27&tspid=100000"
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
End With
ie.document.parentWindow.execScript "javascript:WebForm_DoPostBackWithOptions(new WebForm_PostBackOptions(""dgITMatrix:0:lnkBtnDownload"", """", true, """", """", false, true))"
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Dim iCnd As IUIAutomationCondition
Set o = New CUIAutomation
h = ie.Hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Open")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
ActiveWorkbook.SaveAs "I:\Cap_Rel\raw_scrapes\Texas_Gas_Transmission\parsed\Texas_Gas_Transmission_CapRel" & Format(Date - 1, "yyyymmdd") & "MACRO", FileFormat:=xlCSV
End Sub

Get Html data from Url's parent window w/o using a IE browser - UPS Tracking Info on Multiple Packages

I hope this is not a dumb question. I have search high and low for an answer with now luck. I am new at using VBA to get information off of the internet. I have a working version that uses IE.doc but it is slow and you have to wait for browsers to load. I provided below a working function i converted into a sub for an example. The issue is that without opening the parent window you do not have access to all of the tracking numbers.
This is the JavaScript i use to call the parent window with Internet Explore. Is this even possable to do? Am i going in the right direction?
IE.document.parentWindow.execScript "handleTrackDetailShowShipments()", "JavaScript"
It is my first time using "With CreateObject("msxml2.xmlhttp")" so maybe i am just asking the question wrong while searching for an answer.
References: Microsoft VBScript Regular Expressions 5.5
VBA:
Sub GetTrackingData_Html_UPS()
Dim TrackN As String
Dim x As Long, y As Long
Dim Htm As Object
Dim i As Integer
Dim theRegex As Object
Dim theString As String
Dim s() As String
Dim myColl As Collection
Dim iCtr As Long
Dim tempArray As Variant
Set myColl = New Collection
Set theRegex = CreateObject("VBScript.RegExp")
With theRegex
.MultiLine = False
.Global = True
.IgnoreCase = False
End With
Set Htm = CreateObject("htmlFile")
TrackN = "1Z7452780345800256"
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://wwwapps.ups.com/WebTracking/processRequest?HTMLVersion=" & _
"5.0&Requester=NES&AgreeToTermsAndConditions=yes&loc=en_US&tracknum=" _
& TrackN & "&WT.z_eCTAid=ct1_eml_Tracking", False
.send
Htm.body.innerHTML = .responseText
End With
'IE.document.parentWindow.execScript "handleTrackDetailShowShipments()", "JavaScript" '< I want data from the parent window
'/\ this works if i use InternetExplorer but it is so slow and hit or miss
Debug.Print Htm.getElementsByTagName("h1")(0).innerText & vbNewLine & _
Htm.getElementsByTagName("h4")(1).innerText & vbNewLine & _
Htm.getElementsByTagName("h4")(4).innerText & vbNewLine & _
"Master Tracking Number: " & Htm.getElementsByTagName("h3")(0).innerText & _
vbNewLine
theRegex.Pattern = "([0-9][A-z][0-9A-z][0-9][0-9][0-9][0-9][0-9A-z][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9])"
Set MyMatches = theRegex.Execute(Htm.body.innerHTML)
If MyMatches.Count <> 0 Then
With MyMatches
For myMatchCt = 0 To .Count - 1
For subMtCt = 0 To .Item(subMtCt).SubMatches.Count - 1
Item = (.Item(myMatchCt).SubMatches.Item(subMtCt))
Tracking = Tracking & Trim(Item) & ","
Next
Next
End With
Else
End If
s = Split(Tracking, ",")
On Error Resume Next
For i = UBound(s) - 1 To 0 Step -1
myColl.Add s(i), CStr(s(i))
Next i
On Error Resume Next
ReDim s(LBound(s) To LBound(s) + myColl.Count - 1)
For i = 1 To myColl.Count
Debug.Print i & " " & myColl(i)
Next i
Set theRegex = Nothing
Set Htm = Nothing
Set MyMatches = Nothing
End Sub

You can load the data from the page and usea regex to find what you want on it and load into a variable.
Try this way using xmlhttp. Edit the url's etc. If it seems to work comment out the if / end if to dump info even if seeming to work. It's vbscript but vbscript works in vb6. You could optimise it by adding it as a reference and making file and explicit xmlhttp object - set file = new microsoft.xmlhttp
On Error Resume Next
Set File = WScript.CreateObject("Microsoft.XMLHTTP")
File.Open "GET", "http://www.microsoft.com/en-au/default.aspx", False
'This is IE 8 headers
File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
File.Send
If err.number <> 0 then
line =""
Line = Line & vbcrlf & ""
Line = Line & vbcrlf & "Error getting file"
Line = Line & vbcrlf & "=================="
Line = Line & vbcrlf & ""
Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description
Line = Line & vbcrlf & "Source " & err.source
Line = Line & vbcrlf & ""
Line = Line & vbcrlf & "HTTP Error " & File.Status & " " & File.StatusText
Line = Line & vbcrlf & File.getAllResponseHeaders
wscript.echo Line
Err.clear
wscript.quit
End If
On Error Goto 0
Set BS = CreateObject("ADODB.Stream")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile "c:\users\test.txt", 2
Also see if these other objects work.
C:\Users>reg query hkcr /f xmlhttp
HKEY_CLASSES_ROOT\Microsoft.XMLHTTP
HKEY_CLASSES_ROOT\Microsoft.XMLHTTP.1.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.3.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.4.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.5.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.6.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.3.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.4.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.5.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.6.0
End of search: 12 match(es) found.
Also be aware there is a limit on how many times you can call any particular XMLHTTP object before a lockout occurs. If that happens, and it does when debugging code, just change to a different xmlhttp object

how to implement regions/code collapse in javascript

How can you implement regions a.k.a. code collapse for JavaScript in Visual Studio?
If there are hundreds of lines in javascript, it'll be more understandable using code folding with regions as in vb/C#.
#region My Code
#endregion

Good news for developers who is working with latest version of visual studio
The Web Essentials are coming with this feature .
Check this out
Note: For VS 2017 use JavaScript Regions : https://marketplace.visualstudio.com/items?itemName=MadsKristensen.JavaScriptRegions

Microsoft now has an extension for VS 2010 that provides this functionality:
JScript Editor Extensions

Thats easy!
Mark the section you want to collapse and,
Ctrl+M+H
And to expand use '+' mark on its left.

For those about to use the visual studio 2012, exists the Web Essentials 2012
For those about to use the visual studio 2015, exists the Web Essentials 2015.3
The usage is exactly like #prasad asked

Blog entry here explains it and this MSDN question.
You have to use Visual Studio 2003/2005/2008 Macros.
Copy + Paste from Blog entry for fidelity sake:
Open Macro Explorer
Create a New Macro
Name it OutlineRegions
Click Edit macro and paste the following VB code:
Option Strict Off
Option Explicit Off
Imports System
Imports EnvDTE
Imports EnvDTE80
Imports System.Diagnostics
Imports System.Collections
Public Module JsMacros
Sub OutlineRegions()
Dim selection As EnvDTE.TextSelection = DTE.ActiveDocument.Selection
Const REGION_START As String = "//#region"
Const REGION_END As String = "//#endregion"
selection.SelectAll()
Dim text As String = selection.Text
selection.StartOfDocument(True)
Dim startIndex As Integer
Dim endIndex As Integer
Dim lastIndex As Integer = 0
Dim startRegions As Stack = New Stack()
Do
startIndex = text.IndexOf(REGION_START, lastIndex)
endIndex = text.IndexOf(REGION_END, lastIndex)
If startIndex = -1 AndAlso endIndex = -1 Then
Exit Do
End If
If startIndex <> -1 AndAlso startIndex < endIndex Then
startRegions.Push(startIndex)
lastIndex = startIndex + 1
Else
' Outline region ...
selection.MoveToLineAndOffset(CalcLineNumber(text, CInt(startRegions.Pop())), 1)
selection.MoveToLineAndOffset(CalcLineNumber(text, endIndex) + 1, 1, True)
selection.OutlineSection()
lastIndex = endIndex + 1
End If
Loop
selection.StartOfDocument()
End Sub
Private Function CalcLineNumber(ByVal text As String, ByVal index As Integer)
Dim lineNumber As Integer = 1
Dim i As Integer = 0
While i < index
If text.Chars(i) = vbCr Then
lineNumber += 1
i += 1
End If
i += 1
End While
Return lineNumber
End Function
End Module
Save the Macro and Close the Editor
Now let's assign shortcut to the macro. Go to Tools->Options->Environment->Keyboard and search for your macro in "show commands containing" textbox
now in textbox under the "Press shortcut keys" you can enter the desired shortcut. I use Ctrl+M+E. I don't know why - I just entered it first time and use it now :)

By marking a section of code (regardless of any logical blocks) and hitting CTRL + M + H you’ll define the selection as a region which is collapsible and expandable.

The JSEnhancements plugin for Visual Studio addresses this nicely.

For those who have come here for Visual Studio Code, the same syntax works
// #region MongoDB Client
const MongoClient = require('mongodb').MongoClient;
const url = constants.credentials["uat"].mongo.url
MongoClient.connect(url, { useUnifiedTopology: true }, function (err, client) {
if (err) {
console.log(err);
}
else {
docDB = client.db("middlewareDB");
}
});
// #endregion
When collapsed, it looks like below

Thanks to 0A0D for a great answer. I've had good luck with it. Darin Dimitrov also makes a good argument about limiting the complexity of your JS files. Still, I do find occasions where collapsing functions to their definitions makes browsing through a file much easier.
Regarding #region in general, this SO Question covers it quite well.
I have made a few modifications to the Macro to support more advanced code collapse. This method allows you to put a description after the //#region keyword ala C# and shows it in the code as shown:
Example code:
//#region InputHandler
var InputHandler = {
inputMode: 'simple', //simple or advanced
//#region filterKeys
filterKeys: function(e) {
var doSomething = true;
if (doSomething) {
alert('something');
}
},
//#endregion filterKeys
//#region handleInput
handleInput: function(input, specialKeys) {
//blah blah blah
}
//#endregion handleInput
};
//#endregion InputHandler
Updated Macro:
Option Explicit On
Option Strict On
Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports System.Diagnostics
Imports System.Collections.Generic
Public Module JsMacros
Sub OutlineRegions()
Dim selection As EnvDTE.TextSelection = CType(DTE.ActiveDocument.Selection, EnvDTE.TextSelection)
Const REGION_START As String = "//#region"
Const REGION_END As String = "//#endregion"
selection.SelectAll()
Dim text As String = selection.Text
selection.StartOfDocument(True)
Dim startIndex As Integer
Dim endIndex As Integer
Dim lastIndex As Integer = 0
Dim startRegions As New Stack(Of Integer)
Do
startIndex = text.IndexOf(REGION_START, lastIndex)
endIndex = text.IndexOf(REGION_END, lastIndex)
If startIndex = -1 AndAlso endIndex = -1 Then
Exit Do
End If
If startIndex <> -1 AndAlso startIndex < endIndex Then
startRegions.Push(startIndex)
lastIndex = startIndex + 1
Else
' Outline region ...
Dim tempStartIndex As Integer = CInt(startRegions.Pop())
selection.MoveToLineAndOffset(CalcLineNumber(text, tempStartIndex), CalcLineOffset(text, tempStartIndex))
selection.MoveToLineAndOffset(CalcLineNumber(text, endIndex) + 1, 1, True)
selection.OutlineSection()
lastIndex = endIndex + 1
End If
Loop
selection.StartOfDocument()
End Sub
Private Function CalcLineNumber(ByVal text As String, ByVal index As Integer) As Integer
Dim lineNumber As Integer = 1
Dim i As Integer = 0
While i < index
If text.Chars(i) = vbLf Then
lineNumber += 1
i += 1
End If
If text.Chars(i) = vbCr Then
lineNumber += 1
i += 1
If text.Chars(i) = vbLf Then
i += 1 'Swallow the next vbLf
End If
End If
i += 1
End While
Return lineNumber
End Function
Private Function CalcLineOffset(ByVal text As String, ByVal index As Integer) As Integer
Dim offset As Integer = 1
Dim i As Integer = index - 1
'Count backwards from //#region to the previous line counting the white spaces
Dim whiteSpaces = 1
While i >= 0
Dim chr As Char = text.Chars(i)
If chr = vbCr Or chr = vbLf Then
whiteSpaces = offset
Exit While
End If
i -= 1
offset += 1
End While
'Count forwards from //#region to the end of the region line
i = index
offset = 0
Do
Dim chr As Char = text.Chars(i)
If chr = vbCr Or chr = vbLf Then
Return whiteSpaces + offset
End If
offset += 1
i += 1
Loop
Return whiteSpaces
End Function
End Module

This is now natively in VS2017:
//#region fold this up
//#endregion
Whitespace between the // and # does not matter.
I do not know what version this was added in, as I cannot find any mention of it in the changelogs. I am able to use it in v15.7.3.

For VS 2019, this should work without installing anything:
//#region MyRegion1
foo() {
}
//#endregion
//#region MyRegion2
bar() {
}
//#endregion

It works like a charm in PhpStorm
//#region My Region 1
...
//#endregion
//#region My Region 2
...
//#endregion

On VS 2012 and VS 2015 install WebEssentials plugin and you will able to do so.
http://vswebessentials.com/features/javascript

For visual studio 2017.
//#region Get Deactivation JS
.
.
//#endregion Get Deactivation JS
This was not working earlier so I downloaded extension from here
Extension Name(JavaScript Regions) By Mads Kristensen

if you are using Resharper
fallow the steps in this pic
then write this in template editor
//#region $name$
$END$$SELECTION$
//#endregion $name$
and name it #region as in this picture
hope this help you

None of these answers did not work for me with visual studio 2017.
The best plugin for VS 2017: JavaScript Regions
Example 1:
Example 2:
Tested and approved:

Region should work without changing settings
//#region Optional Naming
var x = 5 -0; // Code runs inside #REGION
/* Unnecessary code must be commented out */
//#endregion
To enable collapsing comment area /**/
/* Collapse this
*/
Settings -> Search "folding" -> Editor: Folding Strategy -> From "auto" to "indentation".
TAGS: Node.js Nodejs Node js
Javascript ES5 ECMAScript comment folding hiding region
Visual studio code vscode 2018 version 1.2+
https://code.visualstudio.com/updates/v1_17#_folding-regions

Not only for VS but nearly for all editors.
(function /* RegionName */ () { ... })();
Warning: has disadvantages such as scope.