This is a simple VBS script. But when I double-click on this, I get Invalid Character 800A0408 on Line 1, Character 1, which I think is the first "Dim". I am new to VBS--can u tell me what I did wrong? FYI, I have an XP OS and IIS6 Manager installed.
' This script adds the necessary Windows Presentation Foundation MIME types
' to an IIS Server.
' To use this script, just double-click or execute it from a command line.
' Running this script multiple times results in multiple entries in the IIS MimeMap.
Dim MimeMapObj
Dim MimeMapArray
Dim WshShell
Dim oExec
Const ADS_PROPERTY_UPDATE = 2
' Set the MIME types to be added
Dim MimeTypesToAddArray = Array(".manifest", "application/manifest", ".xaml", _
"application/xaml+xml", ".application", "application/x-ms-application", _
".deploy", "application/octet-stream", ".xbap", "application/x-ms-xbap", _
".xps", "application/vnd.ms-xpsdocument")
' Get the mimemap object
Set MimeMapObj = GetObject("IIS://LocalHost/MimeMap")
' Call AddMimeType for every pair of extension/MIME type
For counter = 0 to UBound(MimeTypesToAddArray) Step 2
AddMimeType MimeTypesToAddArray(counter), MimeTypesToAddArray(counter+1)
Next
' Create a Shell object
Set WshShell = CreateObject("WScript.Shell")
' Stop and Start the IIS Service
Set oExec = WshShell.Exec("net stop w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = WshShell.Exec("net start w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = Nothing
' Report status to user
WScript.Echo "Windows Presentation Foundation MIME types have been registered."
' AddMimeType Sub
Sub AddMimeType(ByVal Ext, ByVal MType)
' Get the mappings from the MimeMap property.
MimeMapArray = MimeMapObj.GetEx("MimeMap")
' Add a new mapping.
i = UBound(MimeMapArray) + 1
ReDim Preserve MimeMapArray(i)
MimeMapArray(i) = CreateObject("MimeMap")
MimeMapArray(i).Extension = Ext
MimeMapArray(i).MimeType = MType
MimeMapObj.PutEx(ADS_PROPERTY_UPDATE, "MimeMap", MimeMapArray)
MimeMapObj.SetInfo()
End Sub
If you open the file with vim and use the ex command 'set list' it will show you any invisible characters that may be causing this issue.
Quoting http://classicasp.aspfaq.com/general/why-do-i-get-800a0408-errors.html
If you cut and paste code from other
sources (e.g. web sites, other
editors, etc) you often bring along
characters that don't show up in
Notepad but are, nonetheless, present
-- or do appear as non-prinatable characters, that look like little
squares. If you're looking at the line
in question and it isn't simply an
unclosed string or a premature
carriage return, try deleting the
line(s) altogether and re-typing them
by hand. This should eliminate the
possibility of 'invisible' problem
characters mucking up the stream.
Check the encoding when you save the file, must be ANSI in NotePad
Related
I am a student in computer science and for a project I need to be able to read from a text file in a way that each line is assigned to a space within an array. This should happen so that each line of text file is read in the order that it appears in the text file. I would also appreciate any methods of writing to a text file as well.
If this question is already explained, could you please direct me to the existing answer.
Things to note:
1) I am coding in a console application in VB.NET
2) I am relatively new at coding
You can do it like this:
Dim sFile As String = "D:\File.txt"
Dim aLines As String() = System.IO.File.ReadAllLines(sFile)
System.IO.File.WriteAllLines(sFile, aLines)
Here's a sample from the official documentation:
Imports System.IO
Public Class Test
Public Shared Sub Main()
Dim path As String = "c:\temp\MyTest.txt"
Dim sw As StreamWriter
' This text is added only once to the file.
If File.Exists(path) = False Then
' Create a file to write to.
Dim createText() As String = {"Hello", "And", "Welcome"}
File.WriteAllLines(path, createText)
End If
' This text is always added, making the file longer over time
' if it is not deleted.
Dim appendText As String = "This is extra text" + Environment.NewLine
File.AppendAllText(path, appendText)
' Open the file to read from.
Dim readText() As String = File.ReadAllLines(path)
Dim s As String
For Each s In readText
Console.WriteLine(s)
Next
End Sub
End Class
Remarks
This method opens a file, reads each line of the file, then adds each line as an element of a string array. It then closes the file. A line is defined as a sequence of characters followed by a carriage return ('\r'), a line feed ('\n'), or a carriage return immediately followed by a line feed. The resulting string does not contain the terminating carriage return and/or line feed.
Module Module1
Sub Main()
'Declare four variables
Dim oReader As New System.IO.StreamReader(".\archive01.txt") 'This file has to exist in the aplication current directory.
Dim oWriter As New System.IO.StreamWriter(".\archive02.txt") 'This file will be created by the software.
Dim oArray() As String = {}
Dim oString As String = Nothing
'For reading from .\archive01.txt and to load in oArray().
oString = oReader.ReadLine
While Not oString Is Nothing
If UBound(oArray) = -1 Then 'Ubound = Upper Bound, also exist LBound = Lower Bound.
ReDim oArray(UBound(oArray) + 1)
Else
ReDim Preserve oArray(UBound(oArray) + 1)
End If
oArray(UBound(oArray)) = New String(oString)
oString = oReader.ReadLine
End While
oReader.Close()
'For writing from oArray() to .\archive02.txt.
For i = 0 To oArray.Count - 1 Step 1
oWriter.WriteLine(oArray(i))
Next
oWriter.Close()
End Sub
End Module
Hi, try with this code. It works well. I hope that this helps to you to learn how to do this kind of things. Thank you very much. And happy codding!. :)
So I have created a visual basic script in outlook that creates a random signature by pulling from Git.
The script works correctly but whenever I restart my machine the script doesn't run at all.
I fixed the issue by going to
"File"->"Options"->"Trust Center"->"Trust Center Settings..."->"Macro Settings"->"Enable all macros"
This let the VBA code work whenever I opened and closed Outlook but is there a better way to have the code work whenever I reopen Outlook or restart my machine.
I have tried to use
Private Sub Application_Startup()
MsgBox "Hi"
End Sub
While that code did work when I first put it in, whenever I restarted outlook it said it couldn't run because "Macros were disabled"
Here is my code for the random signature, anyway to have this work whenever I restart outlook or my machine? Or is the macro setting I edited the correct way to go?
Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
' Validate that the item sent is an email.
If Item.Class <> olMail Then Exit Sub
'These first variables is to find the file the .bat file created within the AppData folder
'Set enviro to %APPDATA%
Dim enviro As String
enviro = CStr(Environ("APPDATA"))
'Create a new variable that sets the file path for the RepoDir.txt
RepoPath = enviro & "\RepoDir.txt"
'Create a new variable to grab the line of text in RepoDir.txt
Dim RepoFilePath As String
Dim strFirstLine As String
'The new variable calls the RepoPath Variable, opens it and reads the first line of the file and copies it into a variable
RepoFilePath = RepoPath
Open RepoFilePath For Input As #1
Line Input #1, strFirstLine
Close #1
'The script runs a Shell command that opens the command line, cds to the Repo path within the str variable, does a git pull, and outputs the error level to a file in the temp directory
Shell ("cmd /c cd " & strFirstLine & " & git pull RandomSig & echo %ERRORLEVEL% > %TEMP%\gitPull.txt 2>&1")
'These second set of variables is to find the file the Shell command created within the TEMP folder
'Set enviro to %TEMP%
Dim Gitenviro As String
Gitenviro = CStr(Environ("TEMP"))
'Create a new variable that sets the file path for the RepoDir.txt
PullResult = Gitenviro & "\gitPull.txt"
'Create a new variable to grab the line of text in RepoDir.txt
Dim GitFilePath As String
Dim GitFirstLine As String
'The new variable calls the PullResult Variable, opens it and reads the first line of the file and copies it into a variable
GitFilePath = PullResult
Open GitFilePath For Input As #2
Line Input #2, GitFirstLine
Close #2
'MsgBox (GitFirstLine)
'The variable is checked to see if it does not equal 0, and if it doesn't the message is cancelled
If GitFirstLine <> 0 Then
MsgBox "There was an error when attempting to do the Git Pull, cancelling message"
Cancel = True
End If
Const SearchString = "%Random_Line%"
Dim QuotesFile As String
QuotesFile = strFirstLine & "quotes.txt"
If InStr(Item.Body, SearchString) Then
If FileOrDirExists(QuotesFile) = False Then
MsgBox ("Quotes file wasn't found! Canceling message")
Cancel = True
Else
Dim lines() As String
Dim numLines As Integer
numLines = 0
' Open the file for reading
Open QuotesFile For Input As #1
' Go over each line in the file and save it in the array + count it
Do Until EOF(1)
ReDim Preserve lines(numLines + 1)
Line Input #1, lines(numLines)
numLines = numLines + 1
Loop
Close #1
' Get the random line number
Dim randLine As Integer
randLine = Int(numLines * Rnd()) + 1
' Insert the random quote
Item.HTMLBody = Replace(Item.HTMLBody, SearchString, lines(randLine))
Item.HTMLBody = Replace(Item.HTMLBody, "%Random_Num%", randLine)
End If
End If
End Sub
Function FileOrDirExists(PathName As String)
Dim iTemp As Integer
On Error Resume Next
iTemp = GetAttr(PathName)
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
On Error GoTo 0
End Function
It’s highly recommended to leave your macro security setting to only allow self-sign certificate Macros,
Do not use the Low option or run all
Create a self-signing certificate
Go to Start > All Programs > Microsoft Office > Microsoft Office Tools, and then click Digital Certificate for VBA Projects.
In the Your certificate's name box, type in name for the certificate.
Click OK. then SelfCert Success message will appears, click OK.
Go to Developer tab > click Visual Basic. or ALT+F11
In Visual Basic Editor, go to Tools > Digital Signature.
Digital Signature dialog appears and click on Choose and you’ll get a screen to select a certificate. Now you can choose the certificate you just created.
Edit
locating SelfCert.exe
Go to Start menu and typing VBA should bring up the SelfCert.exe.
Alternative method of locating SelfCert.exe
if you Can’t find it in the Start Menu? then By default you can find SelfCert.exe in the following location
Windows 32-bit
C:\Program Files\Microsoft Office\Office <version number>
Windows 64-bit with Office 32-bit
C:\Program Files (x86)\Microsoft Office\Office <version number>
Windows 64-bit with Office 64-bit
C:\Program Files\Microsoft Office\Office <version number>
Office 365 (Subscription based or Click-to-Run version of Office 2013)
C:\Program Files\Microsoft Office 15\root\office15
If SelfCert.exe is not installed
Then run Office setup and choose Add or Remove Features.
With older versions of Office you’ll need to choose Custom installation and then Advanced customization.
Expand the Office Shared Features section and select Digital Certificate for VBA Projects to run from your computer.
Simply run SelfCert.exe after locating it.
I have following code in an lotusscript agent that removes attachments from NotesDocuments. But NotesDocument.save() causes loss of rich text formatting (font, color). Is there any way to retain the formatting?
Sub removeAttachments_v2(doc As NotesDocument)
Dim session As NotesSession
Dim rtitem As Variant
Dim filename As String
Dim ans As Variant
Set session = New NotesSession
Dim richstyle As NotesRichTextStyle
Set richstyle = session.CreateRichTextStyle
richstyle.NotesColor = COLOR_BLUE
If doc.HasEmbedded Then
Set rtitem = doc.getfirstitem("Body")
If (rtitem.type = RICHTEXT) Then
ForAll object In rtitem.EmbeddedObjects
If (object.Type = EMBED_ATTACHMENT) Then
filename = object.source
Call object.remove
Call rtitem.AddNewLine( 2 )
Call rtitem.AppendStyle(richstyle)
Call rtitem.AppendText( "Attachemnt removed: " & filename )
Call doc.Save( True, True , True )
End If
End ForAll
End If
End If
End sub
Edit1: Initialize function
Sub Initialize
Dim db As New NotesDatabase("","")
Dim col As NotesDocumentCollection
Dim doc As NotesDocument
Call db.Open("", "C:\this\is\db\dir\test.nsf")
Set col = db.Alldocuments
Set doc = col.Getfirstdocument()
While Not ( doc Is Nothing )
Call RemoveAttachments_v2(doc)
Call doc.Save(False, False, False)
Set doc = col.GetNextDocument( doc )
Wend
End Sub
Despite of the fact, that you save the document for every attachment I cannot find any reason, why this should happen. I just copied your code in an agent, and it removes the attachments as desired and appends the text in blue...
No formatting is lost...
The error has to be somewhere else in your code, probably in the calling function.
OLD ANSWER (wrong due to own tests, just kept here as history):
The Problem here most probably is: you defined rtitem as Variant. And
getfirstitem gets you a NotesItem instead of a NotesRichtextItem, so
when saving, it is converted to a "plain Text" item.
Most probably you used Variant instead of NotesRichtextItem, because
there are Mime- mails where defining the variable as NotesRichtextItem
will cause an "Type Missmatch" or similar error. As long as you do not
write anything back this is OK.
As Mime Mails need complete different handling to achieve your goal,
you should first fix the code for pure NotesRichtextItems by using the
right type, and then write another code- branch for handling Mime-
items
Hey I have this do until loop that takes a text file made into a string ("strnotapprovedData") and then calls this function that runs a command to delete the share. I keep getting the error object required: "xxxx". How do I fix this is the problem the function the loop statement or the string.
Function:
Function DeleteThisShare(Value)
DeleteThisShare = "net share " & Share & " \DELETE"
Set objShell = CreateObject("Wscript.Shell")
Msgbox AddQuotes(DeleteThisShare)
objShell.Run DeleteThisShare
End Function
Loop Statement:
Do Until strnotapprovedData.AtEndOfStream
Dim objShare : objShare = Split(strnotapprovedData,vbCrLf)
notapprovedShares = objShare
DeleteThisShare(notapprovedShares)
Loop
String:
Dim notapprovedList, notapprovedShares
Set notapprovedList = objFSo.OpenTextFile ("C:\Users\abro\Shares_Not_Approved.txt")
Dim strnotapprovedFile, strnotapprovedData
strnotapprovedFile = ("C:\Users\abro\Shares_Not_Approved.txt")
strnotapprovedData = objFSO.OpenTextFile(strnotapprovedFile,ForReading).ReadAll
Reply to Chris Nielsen
Well I added this and the same problem still occurs
strnotapprovedData = objFSO.OpenTextFile(strnotapprovedFile,ForReading).ReadAll
Do Until objnotapprovedLines.AtEndOfStream
objnotapprovedLines = Split(Trim(strnotapprovedData),vbCrLf)
DeleteThisShare(objnotapprovedLines)
Loop
strnotapprovedData is set to a string as a result of the ReadAll method of the file system object. Since it is a string and not a stream, it will not have an AtEndOfStream property. Instead, you should split it on line breaks and loop over the resulting array.
Response to edit:
Your code does not show where objnotapprovedLines is being defined or initialized. From your usage, I presume it starts life as a stream, but I have no way to know that. However, on the first line after your DO, you overwrite it to be an array. Arrays do not have an AtEndOfStream property, so that would certainly cause the error, even if nothing else has.
Here is some untested code to try:
' Define a new variable called "notApprovedLines"
' VBScript is loosely-typed, so this could be anything at this point.
Dim notApprovedLines
' Read the contents of the file into the "notApprovedLines" variable.
' This assumes that you have a variable named "strnotapprovedFile" that
' contains the path to the file, as your example code indicates. At the
' end of this, the "notApprovedLines" variable contains the entire contents
' of the file as one giant string.
notApprovedLines = objFSO.OpenTextFile(strnotapprovedFile, ForReading).ReadAll
' Split the contents of the file into an array, so we can deal with one line at
' a time. After this, "notApprovedLines" will be an array of strings, with each
' entry representing one line of the original file.
notApprovedLines = Split(notApprovedLines, vbCrLf)
' Loop over those lines
Dim x, k, line
' This sets the upper boundary of the loop.
k = uBound(notApprovedLines)
' In VBScript, arrays start at zero. The "x" is our counter variable. Its
' value will be incremented with each iteration of the loop, so we hit the
' entries one at a time.
For x = 0 To k
' Trim whitespace away from each line. After this executes, the "line"
' variable will contain a single line from the file, as a string, without
' and leading or trailing whitespace.
line = Trim(notApprovedLines(x))
' We don't want to process blank lines, if any exist. This test lets us
' skip those. Any line that contained only whitespace would also be
' skipped here, since it's length would be zero after trimming away the
' whitespace.
If Len(line) > 0 Then
' This executes your function. I have not really proofed it very
' closely. Let's hope it works! =)
DeleteThisShare(line)
End If
Next
I'm writing a macro which goes through a document and tries to parse it by Style. Right now, anything in the designated style is copied onto the immediate window. Is there a way to automate the macro further to move the text from the immediate window into a txt file? Otherwise, anyone using the macro would not be able to see the text unless they opened up VBA, correct?
Here's my suggestion: write to the immediate window AND to a file at the same time. Examples below.
Why make the information first transit in the immediate window, and only then write it to a file from there? That just sounds perversely and uselessly difficult!
Dim s As String
Dim n As Integer
n = FreeFile()
Open "C:\test.txt" For Output As #n
s = "Hello, world!"
Debug.Print s ' write to immediate
Print #n, s ' write to file
s = "Long time no see."
Debug.Print s
Write #n, s ' other way of writing to file
Close #n
Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject
Dim txs As Scripting.TextStream
Set txs = FSO.CreateTextFile("C:\test2.txt")
s = "I like chickpeas."
Debug.Print s ' still writing to immediate
txs.WriteLine s ' third way of writing to file
txs.Close
Set txs = Nothing
Set FSO = Nothing
Note that this last bit of code requires a reference to be set: Tools > References > checkmark at Microsoft Scripting Runtime.
Put this code to immediate window and hit enter to write the List to JSON text in C#.
System.IO.File.WriteAllText(#"C:\Users\m1028200\Desktop\Json2.txt",
JsonConvert.SerializeObject(resultsAll));
I would recommend to use some best-practices-based logging framework like VBA Logging, which supports file logging or console configurably in parallel etc.
example usage (e.g. in some Foo.bas module):
Sub MySub()
Logging.setModulName (Application.VBE.ActiveVBProject.Name)
Set log = Logging.getNewLogger(Application.VBE.ActiveVBProject.Name)
Call log.setLoggigParams(Logging.lgALL, True, True, True) ' log ALL to Console, Buffer, File
log.logINFO "This is my message ..", "MySub"
End Sub
resulting in something like (both in console and vba_logging.log file):
(16.12.2018 13:08:30)[XlsxMgr::MySub]-INFO: This is my message ..
where the log config file looks like this:
## vba_logging.properties
LOG_LEVEL = info
LOG_TO_CONSOLE = True
LOG_TO_BUFFER = True