Please help me to change this code to accept a parameter in the command line
Function to remove accents - diachritics.
Function EliminarAcentos(texto)
Dim i, s1, s2
s1 = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜàáâãäåçèéêëìíîïòóôõöùúûü"
s2 = "AAAAAACEEEEIIIIOOOOOUUUUaaaaaaceeeeiiiiooooouuuu"
If Len(texto) <> 0 Then
For i = 1 To Len(s1)
texto = Replace(texto, Mid(s1,i,1), Mid(s2,i,1))
Next
End If
EliminarAcentos = texto
End Function
I need to run the script like this:
>remove_accents Dídímênsô
Didimenso
The error you mention in your comment ("remove_acentos.vbs(1, 36) Erro de compilação do Microsoft VBScript: ')' esperado") is not caused by the code you published.
This
Option Explicit
Function EliminarAcentos(texto)
Dim i, s1, s2
s1 = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜàáâãäåçèéêëìíîïòóôõöùúûü"
s2 = "AAAAAACEEEEIIIIOOOOOUUUUaaaaaaceeeeiiiiooooouuuu"
If Len(texto) <> 0 Then
For i = 1 To Len(s1)
texto = Replace(texto, Mid(s1,i,1), Mid(s2,i,1))
Next
End If
EliminarAcentos = texto
End Function
Dim texto : texto = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜàáâãäåçèéêëìíîïòóôõöùúûü"
If WScript.Arguments.Count > 0 Then texto = WScript.Arguments(0)
WScript.Echo EliminarAcentos(texto)
compiles and runs successfully - to demonstrate the use of .Arguments.
Related
I try to export to Excel with the fpsread plugin, but there really is no information on how, I have searched the manual but they only show me how to do it with .net
Will someone have an idea?
I managed to do it was very simple, but wanting to import the titles was the heaviest, but here I leave the code in case any work
Private Sub CmdImportar_Click()
Call Export_Excel(cdgExcel, sprFacturas)
Call HacerBusqueda
End Sub
Public Sub Export_Excel(cdgExcel As CommonDialog, Spread As fpSpread)
Dim Header() As String
Dim I As Integer
Dim j As Integer
Dim x As Integer
With cdgExcel
.CancelError = False
.InitDir = "C:/:"
.Filter = "Excel(*.xls)|*.xls"
.ShowSave
If .filename <> "" Then
Spread.Redraw = False
For I = 1 To Spread.ColHeaderRows
ReDim Header(Spread.MaxCols) As String
Spread.Row = SpreadHeader + (I - 1)
For j = 1 To Spread.MaxCols
Spread.Col = j
Header(j) = Spread.Text & ""
Next j
Spread.MaxRows = Spread.MaxRows + 1
Spread.Row = I
Spread.Action = ActionInsertRow
For j = 1 To Spread.MaxCols
Spread.Col = j
Spread.CellType = Spread.CellType
Spread.TypeHAlign = Spread.TypeHAlign
Spread.TypeVAlign = Spread.TypeVAlign
Spread.Text = Header(j) & ""
Next j
Next I
x = Spread.ExportToExcel(.filename, "Sheet1", "")
For I = 1 To Spread.ColHeaderRows
Spread.Row = 1
Spread.Action = ActionDeleteRow
Next I
If x = True Then
MsgBox .filename & vbNewLine & "Se ha Importado el archivo", vbInformation, "Resultado"
Else
MsgBox "No se ha podido exportar el archivo", vbCritical, "Error"
End If
End If
End With
End Sub
Kind of new to VBS. I'm trying to count the fields in the file and have this code.
Col()
Function Col()
Const FSpec = "C:\test.txt"
Const del = ","
dim fs : Set fs = CreateObject("Scripting.FileSystemObject")
dim f : Set f = fs.OpenTextFile(FSpec, 1)
Dim L, C
Do Until f.AtEndOfStream
L = f.ReadLine()
C = UBound(Split(L, del))
C = C +1
WScript.Echo "Items:", C
Loop
f.Close
End Function
It works however, I don't want to count the delim inside " ".
Here's file content:
1,"2,999",3
So basically, I'm getting 4 items for now but I wanted to get 3. Kind of stuck here.
For an example of my second suggestion, a very simple example could be something like this. Not saying it is perfect, but it illustrates the idea:
Dim WeAreInsideQuotes 'global flag
Function RemoveQuotedCommas(ByVal line)
Dim i
Dim result
Dim current
For i = 1 To Len(line)
current = Mid(line, i, 1) 'examine character
'check if we encountered a quote
If current = Chr(34) Then
WeAreInsideQuotes = Not WeAreInsideQuotes 'toggle flag
End If
'process the character
If Not (current = Chr(44) And WeAreInsideQuotes) Then 'skip if comma and insode quotes
result = result & current
End If
Next
RemoveQuotedCommas = result
End Function
I got this function from the internet. It's doing well when counting days so far, but when the dates is from different year, the result is wrong.
Example:
dateFrom = "2017-12-26"
dateTo = "2018-01-02"
the result will be 28 days, when it supposed to be 6 days.
Here is the function:
Public Function NetWorkdays(dtStartDate, dtEndDate, arrHolidays)
Dim lngDays
Dim lngSaturdays
Dim lngSundays
Dim lngHolidays
Dim lngAdjustment
Dim dtTest
Dim i, x
lngDays = DateDiff("d", dtStartDate, dtEndDate)
lngSundays = DateDiff("ww", dtStartDate, dtEndDate, vbSunday)
lngSaturdays = DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSaturday, dtStartDate, dtStartDate - Weekday(dtStartDate, vbSunday)), dtEndDate)
For x = LBound(arrHolidays) To UBound(arrHolidays)
For i = 0 To lngDays
dtTest = DateAdd("d", i, dtStartDate)
If arrHolidays(x) = dtTest And Weekday(dtTest) <> 1 And Weekday(dtTest) <> 7 Then
lngHolidays = lngHolidays + 1
End If
Next
Next
If Weekday(dtStartDate, vbSunday) = vbSunday Or Weekday(dtStartDate, vbSunday) = vbSaturday Then
lngAdjustment = 0
Else
lngAdjustment = 1
End If
NetWorkdays = lngDays - lngSundays - lngSaturdays - lngHolidays + lngAdjustment
End Function
Public Function IIf(expr, truepart, falsepart)
If expr Then IIf = truepart Else IIf = falsepart
End function
Can anybody point it out anything to repair?
dateFrom = #2017-12-26#
dateTo = #2018-01-02#
Msgbox Dateto - datefrom,, "Result"
returns
---------------------------
Result
---------------------------
7
---------------------------
OK
---------------------------
As indiated by the type prefixes in the prototype:
Public Function NetWorkdays(dtStartDate, dtEndDate, arrHolidays)
the function expects Dates, not Strings. Evidence:
Option Explicit
(copy of function)
Dim dp, n
For Each dp In Array(Array("2017-12-26", "2018-01-02"))
On Error Resume Next
n = NetWorkdays(dp(0), dp(1), Array())
If Err Then n = Err.Description
On Error GoTo 0
WScript.Echo TypeName(dp(0)), dp(0), dp(1), n
dp(0) = CDate(dp(0))
dp(1) = CDate(dp(1))
WScript.Echo TypeName(dp(0)), dp(0), dp(1), NetWorkdays(dp(0), dp(1), Array())
Next
output (german locale):
cscript 47921079.vbs
String 2017-12-26 2018-01-02 Typenkonflikt
Date 26.12.2017 02.01.2018 6
Depending on versions, locales and the phase of the moon, you may have to replace the CDate() call with something more reliable.
My script is doing the following point :
Retrieve all my selected folder files
Class them by date (From the recent one to the older)
Show them in a window
Here is my VBS Script (I retrieve it here):
Option Explicit
Const PathMDB = "C:\Users\C8461789\Desktop\test_script"
MsgBox TriRepertoire,,"Enumération " & PathMDB
'---lister les fichiers du répertoire ---
Function TriRepertoire()
Dim fso, fichier, fileItem
Dim i, imax, z, valeur, cible, liste
Set fso = CreateObject("Scripting.FileSystemObject")
imax = 0
'début de l'énumération
For Each fichier In fso.GetFolder(PathMDB).Files
Set fileItem = fso.GetFile(fichier)
imax = imax + 1
ReDim Preserve Tableau(2, imax)
Tableau(1, imax) = Fichier.Name
Tableau(2, imax) = FileItem.DateLastModified
'---trier les fichiers par ordre décroissant de création ---
Do
Valeur = 0
For i = 1 To imax - 1
If InStr(Tableau(1,i), "average", vbTextCompare) > 0 Then
If CDate(Tableau(2, i)) < CDate(Tableau(2, i + 1)) Then
For z = 1 To 2
Cible = Tableau(z, i)
Tableau(z, i) = Tableau(z, i + 1)
Tableau(z, i + 1) = Cible
Next
Valeur = 1
End If
End If
Next
Loop While Valeur = 1
Set fileItem = nothing
Next
'Affichage du résultat classé
For i = 1 To imax
'If IsNull(Tableau) Then
liste = liste &vbTab& Tableau(1, i) &vbCr
'End If
Next
TriRepertoire = liste
Set fso = nothing
End Function
In order to filter by name my retrieved files, I would like to add the following condition :
For each file name, if it contains "average", add the file name to the table
Else, do nothing
I tried to use
If InStr(Tableau(1,i), "average", vbTextCompare) > 0 Then
But it shows me this error :
You are using InStr incorrectly. Your code:
InStr(Tableau(1,i), "average", vbTextCompare)
The signature for InStr is:
InStr([start,]string1,string2[,compare])
But the gotcha here is that it has two optional parameters, one of them being in the front, with a special condition:
Optional. Specifies the starting position for each search. The search begins at the first character position (1) by default. This parameter is required if compare is specified
So because you are using the fourth parameter with the value vbTextCompare, you need to specify the starting point in the first parameter as well, which would be 1 (first character) in your case. So, the corrected code is:
InStr(1, Tableau(1,i), "average", vbTextCompare)
The error message you see basically complains that the first parameter is expected to be an integer, but you are feeding it a string.
See InStr docs.
why now return ....Syntax error
Can i put the Sub rutine in the function? Or better way for this?!
Function SumerizePlanArrays(f_String, f_Type)
Set dic = CreateObject("Scripting.Dictionary")
Sub Add(s)
weight = Split(s,"$")(0)
values = Split(s,"$")(1)
pipes = Split(values, "|")
For Each line In pipes
val = Split(line, ",")
if f_Type = 1 then
dic(val(1)) = (dic(val(1))*weight/100) + CInt(val(2))
elseif f_Type = 2 then
dic(val(1)) = dic(val(1)) + CInt(val(2))
end if
Next
End Sub
arrString = Split(f_String,"#")
For i = 0 to UBound(arrString)
'wei = Split(arrString(i),"$")(0)
Add arrString(i)
Next
Set a = CreateObject("System.Collections.ArrayList")
For Each key In dic.Keys
a.Add "0," & key & "," & dic(key)
Next
a.Sort
result = Join(a.ToArray, "|")
SumerizePlanArrays = result
End Function
Microsoft VBScript compilation error '800a03ea'
Syntax error
/inc_func_projects.asp, line 2592
Sub Add(s)
^
No - you can't put a sub within a function, except in JavaScript or in the server side version called JScript. VBScript and JScript are two completely different languages, however.
You should be doing this...
Function SumerizePlanArrays(f_String, f_Type)
Set dic = CreateObject("Scripting.Dictionary")
arrString = Split(f_String,"#")
For i = 0 to UBound(arrString)
'NOTE: Updated the call to reflect comment by sadrasjd...
Add arrString(i, f_Type, dic)
Next
Set a = CreateObject("System.Collections.ArrayList")
For Each key In dic.Keys
a.Add "0," & key & "," & dic(key)
Next
a.Sort
result = Join(a.ToArray, "|")
SumerizePlanArrays = result
End Function
Sub Add(s, type, dic)
'NOTE: ^Updated the parameters to reflect comment by sadrasjd^
weight = Split(s,"$")(0)
values = Split(s,"$")(1)
pipes = Split(values, "|")
For Each line In pipes
val = Split(line, ",")
if type = 1 then
dic(val(1)) = (dic(val(1))*weight/100) + CInt(val(2))
elseif type = 2 then
dic(val(1)) = dic(val(1)) + CInt(val(2))
end if
Next
End Sub
NOTE: Updated the call to reflect the suggestion made by sadrasjd.