Save as a random filename from a set list - vba

I'm trying to save a file but as a random name from a small list. This is what I have so far:
Option Explicit
Option Base 1
Public Sub SaveToDrive()
Dim categorys(5) As String
categorys(1) = "Adam"
categorys(2) = "James"
categorys(3) = "Henry"
categorys(4) = "William"
categorys(5) = "Keith"
ThisWorkbook.SaveAs Filename:="e:\" & categorys(Int((5 - 1 + 1) * Rnd + 1)).Name
End Sub
Currently, this returns an Invalid Qualifier error on "categorys" in the second to last line.
I'm completely new to VBA, but I was wondering if this was possible or if there was another/better way of doing it.
Thanks.

See below for a working example. A couple of notes:
Arrays in VBA are 0-based by default. This can be changed via Option Base 1 or Option Base 0 in the module header, but the safest approach is to simply specify both the lower and upper bounds when declaring the array (Dim categorys(5) --> Dim categorys(1 To 5))
Not sure what the purpose your - 1 + 1 served so I got rid of it: Int((5 - 1 + 1 --> Int((5
I split up the expression and added some intermediate variables to make things easier to read and maintain going forward (& categorys(Int((5 - 1 + 1) * Rnd + 1)).Name --> Dim RandomIndex...)
Strings are not objects in VBA, so they cannot have methods or properties like .Name
Public Sub SaveToDrive()
Dim categorys(1 To 5) As String
categorys(1) = "Adam"
categorys(2) = "James"
categorys(3) = "Henry"
categorys(4) = "William"
categorys(5) = "Keith"
Dim RandomIndex As Integer
RandomIndex = Int((5 * Rnd) + 1)
Dim FName As String
FName = categorys(RandomIndex)
ThisWorkbook.SaveAs FileName:="e:\" & FName
End Sub

Related

Saving large quantity of String in vba excel

I have to make a application to load images in excel vba, encrypt that image and save it in cells. My problem is the limit of characters in cell ( 32.767 characters ) and my encrypted string is like 800k characters.
I make a function to make a array of string with custom string character length to save in a row but when i save in cells i recive this error:
Public Function SplitString(ByVal TheString As String, ByVal StringLen As Integer) As String()
Dim ArrCount As Integer 'as it is declared locally, it will automatically reset to 0 when this is called again
Dim I As Long 'we are going to use it.. so declare it (with local scope to avoid breaking other code)
Dim TempArray() As String
ReDim TempArray((Len(TheString) - 1) \ StringLen)
For I = 1 To Len(TheString) Step StringLen
TempArray(ArrCount) = Mid$(TheString, I, StringLen)
ArrCount = ArrCount + 1
Next
SplitString = TempArray 'actually return the value
End Function
Dim StringArray As Variant
StringArray = SplitString(EncodeFile(.SelectedItems(1)), 30000)
Dim ind As Integer
ind = 2
For index = 1 To UBound(StringArray)
Sheet5.Cells(55, ind).value = StringArray(index)
ind = ind + 1
Next index
I solve this problem by adding a delay in for loop but it's not a optimal solution
For index = 1 To UBound(StringArray)
Sheet5.Cells(55, ind).value = StringArray(index)
ind = ind + 1
Application.Wait (Now + TimeValue("00:00:01"))
Next index
And now the question: Can I make this more faster or a better way to solve this problem ?
Dump the array into the cells within one row without the loop.
Sheet5.Cells(55, "A").resize(1, ubound(StringArray) + 1) = StringArray

Visual Basic scripting dynamic array

So i have a vb script that sweeps through RAP (Run advertised programs) and if the program has no last run time, but that program's full name into an array, then i have this array echo to a message box. I intialize the array to store 10 values, however to keep the message box clean i wanted to ReDim the array size once it had found all the programs (shoudn't ever be more than 3 but who knows with clients). However i can't seem to get the array to resize and it prints a message box with 10 array slots + the program it found.
Dim vprglist(10)
Dim i
Dim strBuf
Dim intIndex
Set vprograms = oUIResource.GetAvailableApplications
i = 0
For Each vprogram In vprograms
If vprogram.LastRunTime = "" Then
vprglist(i) = vprogram.FullName
i = i + 1
End If
Next
ReDim Preserve vprglist(i)
If vprglist <> Null Then
For intIndex = LBound(vprglist) To UBound(vprglist)
strBuf = strBuf & " - " & vprglist(intIndex) & vbLf
Next
vmsgbox = MsgBox("Do you want to Install(Yes) or Defer(No) the follow software: " & vbLf & strBuf,64+4)
Select Case vmsgbox
You can't re-dimension a fixed-size array (Dim vprglist(10)). If you want a dynamic array, define a "normal" variable and assign an empty array to it:
Dim vprglist : vprglist = Array()
or define it directly with ReDim:
ReDim vprglist(-1)
Then you can re-dimension the array like this:
If vprogram.LastRunTime = "" Then
ReDim Preserve vprglist(UBound(vprglist)+1)
vprglist(UBound(vprglist)) = vprogram.FullName
i = i + 1
End If
ReDim Preserve will copy all elements of the array into a new array, though, so it won't perform too well in the large scale. If performance is an issue, you'd better use the System.Collections.ArrayList class instead:
Dim vprglist : Set vprglist = CreateObject("System.Collections.ArrayList")
...
If vprogram.LastRunTime = "" Then
vprglist.Add vprogram.FullName
i = i + 1
End If

Variables in VBA loops

I'm trying to run a VBA application using a loop and using variables whose names depends on where in the loop I am. Specifically something like
Dim i As Integer
i = 1
Dim varname() As String
while i < 50
varname(i) = asdasd
i = i + 1
Wend
Somehow it can't read varname(i) or whatever. It reports subscript out of range.
I have no idea what the problem is, can someone helt me perhaps?
You need to give your array a capacity first.
Sub max()
Dim i As Integer
i = 1
Dim varname() As String
ReDim varname(49) '<---- There
While i < 50
varname(i) = asdasd
i = i + 1
Wend
End Sub
This is a good resource for VBA arrays:
http://msdn.microsoft.com/en-us/library/office/aa164778(v=office.10).aspx

integer to string problems

I'm trying to make a slot machine program. This procedure that I'm trying to do will assign a name to 3 randomly generated numbers. For some reason I'm getting a conversion error saying that it cant convert the integer to a string. I tried cstr() as well but the problem persisted
Sub GenerateNumbers()
Dim numbers(2) As Integer
Dim names(5) As String
Dim x As Integer
names(0) = "Cherries"
names(1) = "Oranges"
names(2) = "Plums"
names(3) = "Bells"
names(4) = "Melons"
names(5) = "Bar"
For x = 0 To 2
numbers(x) = names(CInt(Int((6 * Rnd()) + 1)))
Next x
End Sub
gives me error: conversion from string "Oranges" to type 'Integer' is not valid
The problem is that you are getting a random string from the names array and trying to assign it to numbers, which is declared as an array of integers. Of course this is not gonna work.
Apart from that, there is also the issue with out of bounds index as Eric pointed out.
Edit in response to comments:
To get the text values of those randomly generated slot machine results you just need to declare the array to store results as strings, same way as names is declared.
To be able to get the results from a separate procedure, you need to change it from Sub to Function, which is a procedure that can return a value, an array of strings in this case. Then you can call this function from your Main or any other procedure and store the returned value in a variable.
I also corrected the part with random result generation.
Module SlotMachine
Sub Main()
Dim slotResults As String()
'Get the results
slotResults = GenerateResults()
'Some further processing of results here, e.g. print results to console
For Each item In slotResults
Console.WriteLine(item)
Next
'Wait for keypress before closing the console window
Console.ReadLine()
End Sub
'Generates random results
Function GenerateResults() As String()
Dim results(2) As String
Dim names(5) As String
Dim x As Integer
names(0) = "Cherries"
names(1) = "Oranges"
names(2) = "Plums"
names(3) = "Bells"
names(4) = "Melons"
names(5) = "Bar"
Randomize()
For x = 0 To 2
results(x) = names(Int(6 * Rnd()))
Next x
Return results
End Function
End Module
Int(6 * Rnd()) will get you 0-5, if you +1, then overflow

Help Visual Basic mixing characters

I'm making an application that will change position of two characters in Word.
Imports System.IO
Module Module1
Sub Main()
Dim str As String = File.ReadAllText("File.txt")
Dim str2 As String() = Split(str, " ")
For i As Integer = 0 To str2.Length - 1
Dim arr As Char() = CType(str2(i), Char())
For ia As Integer = 0 To arr.Length() - 1 Step 2
Dim pa As String
pa = arr(ia + 1)
arr(ia + 1) = arr(ia)
arr(ia) = pa
Next ia
For ib As Integer = 0 To arr.Length - 1
Console.Write(arr(ib))
File.WriteAllText("File2.txt", arr(ib))
Next ib
File.WriteAllText("File2.txt", " ")
Console.Write(" ")
Next i
Console.Read()
End Sub
End Module
For example:
Input: ab
Output: ba
Input: asdasd asdasd
Output: saadds saadds
Program works good, it is mixing characters good, but it doesn't write text to the file. It will write text in console, but not in file.
Note: Program is working only with words that are divisible by 2, but it's not a problem.
Also, it does not return any error message.
Your code is overwriting the file that you have already written with a single space (" ") each time round.
You should only open the file once, and append to it using a stream writer:
Using output = File.CreateText("file2.txt")
' Put the for loop here.
End Using
There are some other things wrong with your code. Firstly, use For Each instead of For, this makes your code much more simple and readable. Secondly, try to avoid For loops altogether where possible. For instance, instead of iterating over the characters to output them one at a time, just create a new string from the char array, and write that:
Dim shuffledWord As New String(arr)
output.Write(shuffledWord)
Some of your types are plain wrong, i.e. you are using String in places instead of Char. You should always use Option Strict On. Then the compiler will not tolerate such code.
You should also prefer to use framework methods over VB-specific methods. This makes it easier to understand for C# programmers, and also makes it easier to translate and change (that is, use the Split method of strings instead of a free function, use ToCharArray instead of a cast to Char() …).
Finally, use meaningful variable names. str, str2 and arr are particularly cryptic because they don’t tell the reader of the code anything of interest about the variables.
Sub Main()
Dim text As String = File.ReadAllText("File.txt")
Dim words As String() = str.Split(" "c)
Using output = File.CreateText("file2.txt")
For Each word In words
dim wordChars = word.ToCharArray()
For i As Integer = 0 To wordChars.Length - 1 Step 2
Dim tmp As Char = wordChars(i + 1)
wordChars(i + 1) = wordChars(i)
arr(i) = tmp
Next
Dim shuffledWord As New String(wordChars)
output.Write(shuffledWord + " ")
Console.Write(huffledWord + " ")
Next
End Using
Console.Read()
End Sub