So this is my situation:
User visits www.a.com where a cookie is set:
$.cookie('panelcookie', userid, {path: '/' });
When this user now visits www.b.com, where our tracking pixel is
<img src="http://www.a.com/trackpixel.asp" width=1 height=1>
, the pixel should write that userid to a log along with other info (the following is what I've come up with so far):
<%
Const ForAppending = 8
Const Create = true
Dim FSO
Dim TS
Dim Panelcookie
Dim MyFileName
Dim strLog
Dim cMyValue
MyFileName = Server.MapPath("asptrack.txt")
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
Set TS = FSO.OpenTextFile(MyFileName, ForAppending, Create)
' Store all the required information in a string Called strLog
strLog = "<br><P><B>" & NOW() & "</B> "
strLog = strLog & Request.ServerVariables("REMOTE_ADDR") & " "
strLog = strLog & Request.ServerVariables("HTTP_REFERER") & " "
strLog = strLog & "User has cookie? " & Request.Cookies("panelcookie") & " "
strLog = strLog & Request.ServerVariables("HTTP_USER_AGENT") & "<BR>"
' Write current information to Log Text File.
TS.write strLog
TS.Writeline ""
%>
How do I accomplish this?
Related
I have multiple inputs in columns from which I need to create table for each column which has headers, Create connection using power query, Using these connections I need to add to the power query, and export it to sheet2. I have attached sample excel sheet for reference. Below is the half code for the same, I am not pro in vba if any one could help in solving the same. Here is the link for the same which I need to automate.
data set
Option Explicit
Public Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim tableobjects As ListObject
Dim sName As String
Dim sFormula As String
Dim wq As WorkbookQuery
Dim bExists As Boolean
Dim vbAnswer As VbMsgBoxResult
Dim vbDataModel As VbMsgBoxResult
Dim i As Long
Dim j As Long
Dim k, l As Long
Dim dStart As Double
Dim dTime As Double
Dim CellAddr As String
Dim CellValue As String
Dim RangeAddr As String
Dim Temp As String
Dim TotalNumberInputs As Integer
Dim answer As Integer
Dim TableExists As Boolean
Dim ListObj As ListObject
Repeat:
TotalNumberInputs = InputBox("Enter the total inputs", "input int number")
If TotalNumberInputs = 0 Then
MsgBox "Invalid Input!!!"
answer = MsgBox("Invalid Input!!! Do you want to continue Macro?", vbQuestion + vbYesNo + vbDefaultButton2, "Next step")
If answer = vbYes Then
GoTo Repeat
Else
Exit Sub
End If
End If
'Set variables
dStart = Timer
Set wb = ActiveWorkbook
Set ws = ActiveSheet
'Check of table exist or else create table
For k = 1 To TotalNumberInputs
ws.Cells(1, k).Select
CellAddr = Selection.Address(RowAbsolute:=False, ColumnAbsolute:=False)
CellValue = Cells(1, l).Value ' "Table" & (k + "0") ' Selection.Value
On Error Resume Next
Set ListObj = ActiveSheet.ListObjects(CellValue)
On Error GoTo 0
If ListObj Is Nothing Then
Range(CellAddr).Select
Range(Selection, Selection.End(xlDown)).Select
RangeAddr = Selection.Address
Range(RangeAddr).Activate
ws.ListObjects.Add(SourceType:=xlSrcRange, Source:=Range(RangeAddr), LinkSource:=False, XlListObjectHasHeaders:=xlYes, tablestyleName:="TableStyleMedium28").Name = CellValue
Else
'If the table does exist clear filter from column C
' ActiveSheet.ListObjects(CellValue).Range.AutoFilter Field:=3
End If
Next k
l = 1
'Loop sheets and tables
' For Each ws In ActiveWorkbook.Worksheets
For Each lo In ws.ListObjects ' For j = 1 To TotalNumberInputs ' For Each lo In ws.ListObjects
sName = lo.Name ' ws.Cells(1, l).Value ' lo.Name
l = l + 1
sFormula = "Excel.CurrentWorkbook(){[Name=""" & sName & """]}[Content]"
'Check if query exists
bExists = False
For Each wq In wb.Queries
If InStr(1, wq.Formula, sFormula) > 0 Then
bExists = True
End If
Next wq
'Add query if it does not exist
If bExists = False Then
' Add a Query
wb.Queries.Add Name:=sName, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Excel.CurrentWorkbook(){[Name=""" & sName & """]}[Content]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Source,{{""" & sName & """, type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
'Add connection
wb.Connections.Add2 Name:="Query - " & sName, _
Description:="Connection to the '" & sName & "' query in the workbook.", _
ConnectionString:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & sName & ";Extended Properties=""""", _
CommandText:="SELECT * FROM [" & sName & "]", _
lCmdtype:=2, _
CreateModelConnection:=False, _
ImportRelationships:=False
'Count connections
i = i + 1
End If
Next lo ' Next j ' Next lo
'Next ws
'Calc run time
dTime = Timer - dStart
MsgBox i & " connections have been created in " & Format(dTime, "0.0") & " seconds.", vbOKOnly, "Process Complete"
End Sub
I try to Extract all lines of a file between 2 strings in another file and without these delimiters.
Example:
[General]
Description=Description
[extractSection]
First Line extracted. It is not an ini section
Last Line extracted
[OthersSection]
blablabla
It seems to work with this script. One of my first vbs.
Set objFS = CreateObject("Scripting.FileSystemObject")
strFile = "E:\Temp\Test.txt"
strTemp = "E:\Temp\Temp.txt"
If objFS.FileExists(strTemp) Then objFS.DeleteFile(strTemp)
Set objFile = objFS.OpenTextFile(strFile)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
If isReading = True Then
If instr(strline,"[") Then
Set objOutFile = objFS.CreateTextFile(strTemp, True)
objOutFile.Write(strLine1)
objOutFile.Close
Exit Do
Else
strline1 = strline1 & strline & vbNewLine
End If
Else
If instr(LCase(strline),"[extractsection]") Then
isReading = True
End If
End If
Loop
objFile.Close
But it seems not very optimized, I have files up to 8Mb.
I would like to try the same thing using Regex. I never used, I have to learn.
I have this as beginning: \[extractsection\]([\s\S]*?)\[[\s\S]
But I would like without the delimiters.
Thank you Wiktor. It seems it is OK with (?<=\[extractSection\]\n)(.*(?:\n(?!\[).*)*) Just let me know what is best (Ram | speed) vs my ReadLine script on top, please
You can give a try for this vbscript without a Regex :
Option Explicit
Dim strFile,strTemp,Full_String,First_Delimiter,Second_Delimiter,Extracted_Data
strFile = "E:\Temp\Test.txt"
strTemp = "E:\Temp\Temp.txt"
Full_String = ReadFileText(strFile)
First_Delimiter = "[extractSection]"
Second_Delimiter = "[OthersSection]"
Extracted_Data = String_Between(Full_String,First_Delimiter,Second_Delimiter)
wscript.echo Extracted_Data
Write2File Extracted_Data,strTemp
'************************************************************************************************
Function String_Between(ByVal Full_String, ByVal First_Delimiter, ByVal Second_Delimiter)
Dim Pos,Pos2
Pos = InStr(Full_String, First_Delimiter)
Pos2 = InStr(Full_String, Second_Delimiter)
If Pos = 0 Or Pos2 = 0 Then
String_Between = "Missing Delimiter"
Exit Function
End If
String_Between = Mid(Full_String, Pos + Len(First_Delimiter), Pos2 - (Pos + Len(First_Delimiter)))
End Function
'***********************************************************************************************
Function ReadFileText(sFile)
Dim objFSO,oTS,sText
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(sFile) Then
MsgBox "CRITICAL ERROR " & VbCrLF & "The File "& DblQuote(sFile) &_
" dosen't exists !",VbCritical,"CRITICAL ERROR"
Wscript.Quit
Else
Set oTS = objFSO.OpenTextFile(sFile)
sText = oTS.ReadAll
oTS.close
set oTS = nothing
Set objFSO = nothing
ReadFileText = sText
End if
End Function
'*********************************************************************************************
Sub Write2File(strText,OutputFile)
Dim fs,ts
Const ForWriting = 2
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(OutputFile,ForWriting,True)
ts.WriteLine strText
ts.Close
End Sub
'*********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
And this one with RegEx
Option Explicit
Dim strFile,strTemp,Full_String,First_Delimiter,Second_Delimiter,Extracted_Data
strFile = "E:\Temp\Test.txt"
strTemp = "E:\Temp\Temp.txt"
Full_String = ReadFileText(strFile)
First_Delimiter = "[extractSection]"
Second_Delimiter = "[OthersSection]"
Extracted_Data = ExtractData(Full_String,First_Delimiter,Second_Delimiter)
wscript.echo Extracted_Data
Write2File Extracted_Data,strTemp
'***********************************************************************************************
Function ExtractData(Full_String,Start_Delim,End_Delim)
Dim fso,f,r,Matches,Contents,Data
Start_Delim = Replace(Start_Delim,"[","\[")
Start_Delim = Replace(Start_Delim,"]","\]")
End_Delim = Replace(End_Delim,"[","\[")
End_Delim = Replace(End_Delim,"]","\]")
Set r=new regexp
r.pattern = "(?:^|(?:\r\n))(:?"& Start_Delim &"\r\n)([\s\S]*?)(?:\r\n)(?:"& End_Delim &")"
Set Matches = r.Execute(Full_String)
If Matches.Count > 0 Then Data = Matches(0).SubMatches(1)
ExtractData = Data
End Function
'***********************************************************************************************
Function ReadFileText(sFile)
Dim objFSO,oTS,sText
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(sFile) Then
MsgBox "CRITICAL ERROR " & VbCrLF & "The File "& DblQuote(sFile) &_
" dosen't exists !",VbCritical,"CRITICAL ERROR"
Wscript.Quit
Else
Set oTS = objFSO.OpenTextFile(sFile)
sText = oTS.ReadAll
oTS.close
set oTS = nothing
Set objFSO = nothing
ReadFileText = sText
End if
End Function
'*********************************************************************************************
Sub Write2File(strText,OutputFile)
Dim fs,ts
Const ForWriting = 2
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(OutputFile,ForWriting,True)
ts.WriteLine strText
ts.Close
End Sub
'*********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
For this code, I am having a problem in using the MID and INSTR functions:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set file = objFSO.OpenTextFile("sample.txt" , ForReading)
Const ForReading = 1
Dim re
Dim controller
Dim action
Set re = new regexp
re.pattern = "(contextPath\s*?[+]\s*?[""][/]\w+?[?]action[=]\w+?[""])"
re.IgnoreCase = True
re.Global = True
Dim line
Do Until file.AtEndOfStream
line = file.ReadLine
For Each m In re.Execute(line)
var = m.Submatches(0)
'I am having a problem with the next two lines:
controller = Mid(var, 1, InStr(var, "contextPath\")) & "[?]action[=]\w+?[""]n"
action = Mid(var, 1, InStr(var, "contextPath\s*?[+]\s*?[""][/]\w+?[?]action[=]")) & """"
Wscript.Echo "controller :" & controller
Wscript.Echo "action: " & action
Next
Loop
With the text file "sample.txt":
contextPath+"/GIACOrderOfPaymentController?action=showORDetails"
contextPath +"/GIACPremDepositController?action=showPremDep"
contextPath+ "/GIACCommPaytsController?action=showCommPayts"
(Notice the spaces beside the plus(+) sign)
How can I make the output look like this:
controller: GIACOrderOfPaymentController
controller: GIACPremDepositController
controller: GIACCommPaytsController
action: showORDetails
action: showPremDep
action: showCommPayts
Instead of capturing the full line, capture the needed data
Option Explicit
Const ForReading = 1
Dim re
Set re = New RegExp
With re
.Pattern = "contextPath\s*\+\s*\""/(\w+)\?action=(\w+)\"""
.IgnoreCase = True
.Global = True
End With
Dim controllers, actions
Set controllers = CreateObject("Scripting.Dictionary")
Set actions = CreateObject("Scripting.Dictionary")
Dim file
Set file = CreateObject("Scripting.FileSystemObject").OpenTextFile("sample.txt" , ForReading)
Dim line, m
Do Until file.AtEndOfStream
line = file.ReadLine
For Each m In re.Execute(line)
controllers.Add "K" & controllers.Count, m.Submatches(0)
actions.Add "K" & actions.Count, m.Submatches(1)
Next
Loop
Dim item
For Each item in controllers.Items()
WScript.Echo "controller: " & item
Next
WScript.Echo ""
For Each item in actions.Items()
WScript.Echo "action: " & item
Next
I have an event listener that updates a list when an action occurs. The list has two taxonomy fields that need to be updated: 'State' and 'Product'
State is a multi-value field and Product is a single-value field. I can clear the 'State' field without issue, but get an error when trying to clear the 'Product' field. Below is the code:
Private Sub RemoveStateProduct(ctx As ClientContext, stateGuidToRemove As String, id As String)
Dim listItems As ListItemCollection
Dim queryXml As String = String.Empty
Dim camlQueryForItem As New CamlQuery()
' get list item from item id
Dim list As List = ctx.Web.Lists.GetByTitle("StateProductList")
Dim fields As FieldCollection = list.Fields
Dim statefield As Field = fields.GetByInternalNameOrTitle("States")
Dim productfield As Field = fields.GetByInternalNameOrTitle("Product")
queryXml = "<View>" & vbCr & vbLf & _
" <Query>" & vbCr & vbLf & _
" <Where>" & vbCr & vbLf & _
" <Eq>" & vbCr & vbLf & _
" <FieldRef Name='ID'/>" & vbCr & vbLf & _
" <Value Type='Counter'>!#itemid</Value>" & vbCr & vbLf & _
" </Eq>" & vbCr & vbLf & _
" </Where>" & vbCr & vbLf & _
" </Query>" & vbCr & vbLf & _
" </View>"
camlQueryForItem.ViewXml = queryXml.Replace("!#itemid", id)
listItems = list.GetItems(camlQueryForItem)
ctx.Load(listItems)
ctx.Load(fields)
ctx.Load(statefield)
ctx.Load(productfield)
ctx.ExecuteQuery()
Dim stateTaxFieldAs TaxonomyField = ctx.CastTo(Of TaxonomyField)(statefield)
Dim productTaxFieldAs TaxonomyField = ctx.CastTo(Of TaxonomyField)(productfield)
Dim item As ListItem = listItems(0)
Dim productTaxFieldValue As TaxonomyFieldValue = Nothing
Dim stateTaxFieldValueCollAs TaxonomyFieldValueCollection = Nothing
Dim stateTermValueString As String = String.Empty
Dim tempString As String = String.Empty
stateTaxFieldValueColl= TryCast(item("State"), TaxonomyFieldValueCollection)
For Each tv As TaxonomyFieldValue In taxfieldvaluecollState
tempString = tv.WssId & ";#" & tv.Label & "|" & tv.TermGuid
If Not stateGuidToRemove.Equals(tv.TermGuid) Then
stateTermValueString = stateTermValueString & tempString & ";#"
End If
Next
stateTermValueString = stateTermValueString.TrimEnd("#", ";")
stateTaxFieldValueColl= New TaxonomyFieldValueCollection(ctx, stateTermValueString, taxfieldState)
taxfieldState.SetFieldValueByValueCollection(item, taxfieldvaluecollState)
If stateTermValueString = String.Empty Then
productTaxFieldValue = TryCast(item("Product"), TaxonomyFieldValue)
'productTaxFieldValue = New TaxonomyFieldValue()
productTaxFieldValue.WssId = 0 '-1
productTaxFieldValue.Label = Nothing 'String.empty() ; vbNull
productTaxFieldValue.TermGuid = Nothing 'String.empty() ; vbNull
taxfieldProduct.SetFieldValueByValue(item, productTaxFieldValue)
End If
item.Update()
ctx.Load(item)
ctx.ExecuteQuery()
End Sub
The error occurs inside this last section:
If stateTermValueString = String.Empty Then
productTaxFieldValue = TryCast(item("Product"), TaxonomyFieldValue)
'productTaxFieldValue = New TaxonomyFieldValue()
productTaxFieldValue.WssId = 0 '-1
productTaxFieldValue.Label = Nothing 'String.empty() ; vbNull
productTaxFieldValue.TermGuid = Nothing 'String.empty() ; vbNull
taxfieldProduct.SetFieldValueByValue(item, productTaxFieldValue)
End If
If stateTermValueString is empty, I know that I must clear out the 'Product' field. I have tried creating a new TaxonomyFieldValue object and setting the values to Nothing (suggested by this article, though that is for 2010). I have also tried using the item's 'Product' field and resetting the values for that to make it empty. I have tried different combinations of values for the WssId, Label, and Guid fields, as shown in the commented sections of those lines. The code returns an error:
creatingField
That's it. That is the entire text of the error message I receive. When I examine the source, it is only this: Microsoft.SharePoint.Client.Runtime
So, the question: How do I programmatically clear a single-value taxonomy field?
Found a solution. For a single-value taxonomy field, you must also update the hidden note field, but you cannot do it through a TaxonomyFieldValue object. You must update the item field directly using an array, and the note field with a string.
After loading the Taxonomy fields and item, you must reload the item fields and execute the query, then use the context to load the hidden note field.
Dim stateTaxField As TaxonomyField = ctx.CastTo(Of TaxonomyField)(statefield)
Dim productTaxField As TaxonomyField = ctx.CastTo(Of TaxonomyField)(productfield)
Dim item As ListItem = listItems(0)
'Add these lines
ctx.Load(stateTaxField)
ctx.Load(productTaxField)
ctx.Load(ctx.Web.Fields, Function(ff) ff.Include(Function(f) f.Id, Function(f) f.InternalName))
ctx.ExecuteQuery()
Dim productNoteField As Field = ctx.Web.Fields.ToList.SingleOrDefault(Function(f) f.Id.Equals(productTaxField.TextField))
I modified the section at the end that was causing so much trouble to update the item fields with empty values:
If termValueString = String.Empty Then
item(productfield.InternalName) = String.Format("-1;#{0}|{1}", String.Empty, Guid.Empty).ToArray
item(productNoteField.InternalName) = String.Format("{0}|{1}", String.Empty, Guid.Empty)
End If
productTaxFieldValue is not longer used and can be removed. This article was most helpful is determining how to format the field strings (and explaining that the productfield needed to be an array, even if is is only a single, 'empty' string). Hope this helps someone else in need.
I'm trying to figure this out and I just cannot get it to work, I'm stuck please help.
I have a .txt file that will look something like this
Example:
GA117.50.0117.50.0117.50.0IL16.08.08.00.016.00.0IN284.09.4274.60.0284.00.0KY137.60.0137.60.0137.60.0TN170.30.0170.30.0170.30.0US725.417.4708.00.0725.40.0TOTAL725.417.4708.00.0725.40.0
What I'm trying to do in classic-asp is to get the letters/word in a dim (and add a str before the letters/word) and the numbers as the value for that dim but only to the first period and 1 more number to the right after the period and then continue to the next letter/word.
so the final outcome would look something like this:
dim strGA
dim strIL
dim strIN
dim strKY
dim strTN
dim strUS
dim strTOTAL
strGA=117.5
strIL=16.0
strIN=284.0
strKY=137.6
strTN=170.3
strUS=725.4
strTOTAL=725.4
Thank you so much for any help with this problem/question.
Consider the following example.
May need to change the pattern according to the variable names.
Dim strTest
strTest = "GA117.50.0117.50.0117.50.0IL16.08.08.00.016.00.0IN284.09.4274.60.0284.00.0KY137.60.0137.60.0137.60.0TN170.30.0170.30.0170.30.0US725.417.4708.00.0725.40.0TOTAL725.417.4708.00.0725.40.0"
Dim re
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = "([a-z]+)(\d+\.\d)"
Dim collMatches
Set collMatches = re.Execute(strTest)
Dim iMatch, strDims, strAssocs
For Each iMatch In collMatches
strDims = strDims & "Dim str" & iMatch.SubMatches(0) & vbCrLf
strAssocs = strAssocs & "str" & iMatch.SubMatches(0) & " = " & iMatch.SubMatches(1) & vbCrLf
Next
Dim strExec
strExec = strDims & vbCrLf & strAssocs
'Dump
Response.Write "Dump:<hr /><pre>" & strExec & "<pre>"
ExecuteGlobal strExec 'Execute the code
'Test
With Response
.Write "Executed:<hr />"
.Write "strGA: " & strGA & "<br />"
.Write "strIL: " & strIL & "<br />"
.Write "strIN: " & strIN & "<br />"
.Write "strKY: " & strKY & "<br />"
.Write "strTN: " & strTN & "<br />"
.Write "strUS: " & strUS & "<br />"
.Write "strTOTAL:" & strTOTAL & "<br />"
End With