How to concatenate _ in vb.net - vb.net

_ in vb.net is used for line continuation. How to concatenate _ in a text.
I am trying this
aPath.ExeConfigFilename = strAppPath & "\" & Environment.UserName.ToString & Thread.CurrentThread.CurrentCulture.Name.ToString &_& xyzConstants.CONFIG_FILE

Change this:
aPath.ExeConfigFilename = strAppPath & "\" & Environment.UserName.ToString &
Thread.CurrentThread.CurrentCulture.Name.ToString &_& xyzConstants.CONFIG_FILE
to this:
aPath.ExeConfigFilename = strAppPath & "\" & Environment.UserName.ToString &
Thread.CurrentThread.CurrentCulture.Name.ToString & "_" & xyzConstants.CONFIG_FILE

Related

Using INSERT INTO with VALUES fails with Run-time error '3078'

I've been to dozens of sites. None address my particular question. All (including official Microsoft) tell me to do what I'm doing.
Dim strSQL As String
strSQL = """INSERT INTO tblVolunteers " & vbCrLf & _
"VALUES (" & [txtTitle] & "," & [txtFirstName] & "," & [txtMiddle] & "," & [txtLastName] & "," & [txtEmail] & _
"," & [txtPhone] & "," & [txtChurch] & "," & [txtGroup] & "," & [txtCouncil] & "," & [chkParCo] & "," & _
[txtMailAdd] & ");"""
CurrentDb.Execute strSQL
Here's what Microsoft has to say:
Run-time error '3078'
The Microsoft Access database engine cannot find the input table or query ""INSERT INTO tblVolunteers
VALUES (Mr.,John,L.,Smith,jlsmith#email.com,800-555-1212,St. Smith's,Smith,1234,-1,10 Smith St.
Smithville, TX 77777-3333);"". Make sure it exists and that its name is spelled correctly.
Why is it looking for a table or query when not only have I specified VALUES but it has picked up all the values from the form?
You could either use my function CSql and concatenate the values like this:
strSQL = "INSERT INTO tblVolunteers " & _
"VALUES (" & CSql([txtTitle]) & "," & CSql([txtFirstName]) & "," & CSql([txtMiddle]) & "," & _
CSql([txtLastName]) & "," & CSql([txtEmail]) & "," & CSql([txtPhone]) & "," & CSql([txtChurch] & "," & _
CSql([txtGroup]) & "," & CSql([txtCouncil]) & "," & CSql([chkParCo]) & "," & CSql([txtMailAdd]) & ");"
or you could skip this mess and use DAO for much cleaner coding and easier debugging:
Dim Records As DAO.Recordset
Dim Sql As String
Sql = "Select * From tblVolunteers"
Set Records = CurrentDb.OpenRecordset(Sql, dbOpenDynaset, dbAppendOnly)
Records.AddNew
Records!Title.Value = Me!txtTitle.Value
Records!FirstName.Value = Me!txtFirstName.Value
Records!Middle.Value = Me!txtMiddle.Value
Records!LastName.Value = Me!txtLastName.Value
Records!Email.Value = Me!txtEmail.Value
Records!Phone.Value = Me!txtPhone.Value
Records!Church.Value = Me!txtChurch.Value
Records!Group.Value = Me!txtGroup.Value
Records!Council.Value = Me!txtCouncil.Value
Records!ParCo.Value = Me!chkParCo.Value
Records!MailAdd.Value = Me!txtMailAdd.Value
Records.Update
Records.Close
Basically you need double quotes qaround the text, so for that you can use CHR(34)
strSQL = "INSERT INTO tblVolunteers " & vbCrLf & _
"VALUES (" & CHR(34) & [txtTitle] & CHR(34) & "," & CHR(34) & [txtFirstName] & CHR(34) & "," & CHR(34) & [txtMiddle] & CHR(34) & "," & CHR(34) & [txtLastName] & CHR(34) & "," & CHR(34) & [txtEmail] & CHR(34) & _
"," & CHR(34) & [txtPhone] & CHR(34) & "," & CHR(34) & [txtChurch] & CHR(34) & "," & CHR(34) & [txtGroup] & CHR(34) & "," & CHR(34) & [txtCouncil] & CHR(34) & "," & CHR(34) & [chkParCo] & CHR(34) & "," & CHR(34) & _
[txtMailAdd] & CHR(34) & ");"
use Access Query Design View..... start with just a single field, and then build field by field...
you can toggle it to SQl View to see the syntax

Excel VBA Save path/name from cells with variables

I am using cells as the file path and filename to save a copy of my workbook.
Here's the code am using now but it puts spaces in between each cell.
Note only the ActiveSheet.Range cells will have the possibility of being blank
Dim NewWb As Workbook
sFile = Control_Sheet_VB.Range("H2") & "\" & ActiveSheet.Range("H8") & " " & ActiveSheet.Range("E10") & " " & ActiveSheet.Range("D14") & " - Ticket #" & Control_Sheet_VB.Range("B2") & Control_Sheet_VB.Range("C2") & ".xlsm"
Set OldWb = ActiveWorkbook
OldWb.SaveCopyAs sFile
Set NewWb = Workbooks.Open(sFile)
How can I make it so if some of the cells that are used as the file name are blank then it dose not put the extra space in the filename
you may go like this:
sFile = Control_Sheet_VB.Range("H2") & "\" & _
IIf(ActiveSheet.Range("H8") <> "", ActiveSheet.Range("H8") & " ", "") & _
IIf(ActiveSheet.Range("E10") <> "", ActiveSheet.Range("E10") & " ", "") & _
IIf(ActiveSheet.Range("D14") <> "", ActiveSheet.Range("D14") & " ", "") & _
" - Ticket #" & Control_Sheet_VB.Range("B2") & _
Control_Sheet_VB.Range("C2") & ".xlsm"

Hyperlink to fire macro in personal.xlsb

I am having a column in an excel with some text(date, sender,subject) which refer to an email. The problem is that(as far as I know) you can hyperlink to an outlook email in public folders, because the email might move(link varies from pc to pc).
So my idea to obtain that email is to make a hyper link that fires of a macro in the personal.xlsb, that then search for that email and display it.
My only problem is that I can not figure out how to link text to start a macro, Worksheet_FollowHyperlink means that I need to put that code in the sheet where my text is.
I guess I could do that, but this implements that I need to create this code when the workbook is opened and remove it when the workbook is closed, unless I have to rename all the files xlsx to xlsm, and because I am unsure if other colleagues have link to the excel sheet I would like to avoid doing so.
So my question is, is there any way to make a hyperlink to personal.xlsb!ShowEmail(cellValue) ? Or is it possible to make direct link to the email in the public folder? Below is the code for creating the email text:
Function getEpostField(projectNumber As String, drawingNumber As String, partNumber As String) As String
On Error Resume Next
Dim myFolderArray() As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim OutApp As Object
Dim myNameSpace As Object
Dim myFolder As Object
Dim myNewFolder As Object
Dim TopPublicFolder As Object
Dim olMail As Variant
Dim myTasks
Dim strFilter As String
Set OutApp = CreateObject("Outlook.Application")
Set myNameSpace = OutApp.GetNamespace("MAPI")
Set TopPublicFolder = myNameSpace.GetDefaultFolder(18)
getEpostField = ""
' array with all subfolders where the item might be...
myFolderArray = Post.helpRequest("XXXXXXXXX")
For i = LBound(myFolderArray) To UBound(myFolderArray)
Set myFolder = TopPublicFolder.Folders("Prototech").Folders(myFolderArray(i, 2)).Folders
For j = 1 To myFolder.Count
If InStr(myFolder(j).Name, projectNumber) Then
If drawingNumber <> "" And partNumber <> "" Then
strFilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & drawingNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & drawingNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & drawingNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & partNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & partNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & partNumber & "%'"
ElseIf drawingNumber <> "" Then
strFilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & drawingNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & drawingNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & drawingNumber & "%'"
ElseIf partNumber <> "" Then
strFilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & partNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & partNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & partNumber & "%'"
Else
getEpostField = "No emails found"
Exit Function
End If
Set filteredItems = myFolder(j).Items.Restrict(strFilter)
If filteredItems.Count = 0 Then
Debug.Print "No emails found"
getEpostField = "No emails found"
found = False
Else
found = True
' this loop is optional, it displays the list of emails by subject.
For Each itm In filteredItems
attachmentString = ""
If itm.Attachments.Count > 0 Then
For Each temp In itm.Attachments
temp2 = InStr(temp.filename, drawingNumber)
If temp2 > 0 Then
attachmentString = attachmentString & temp.filename & " "
End If
Next temp
End If
Debug.Print "Dato:" & Format(itm.CreationTime, "mm.dd.yyyy") & " Subject:" & itm.Subject & " From:" & itm.SenderName & " Attachment:" & attachmentString
getEpostField = getEpostField + "Dato:" & Format(itm.CreationTime, "mm.dd.yyyy") & " Subject:" & itm.Subject & " From:" & itm.SenderName & " Attachment:" & attachmentString
Next
End If
'If the subject isn't found:
If Not found Then
'NoResults.Show
Else
Debug.Print "Found " & filteredItems.Count & " items."
End If
Exit Function
End If
Next j
Next i
End Function
=HYPERLINK("#personal.xlsb!modUtility.TestHL()","Test")
and a test function (returning a range a just results in the link selecting the already-selected cell)
Function TestHL()
Debug.Print "OK"
Set TestHL = Selection
End Function

How to add an incremental count (version) to a string (file) in Excel/VBA?

I have tried a lot of different things, and it seems like I cannot get it to work. So basically, this is a small piece of my complete code.
I am using Microsoft Scripting Runtime to save the file, using the FileExists() to check if the file actually exist before saving.
This is working fine if I remove the IF-statement/Loop.
However, now it feels like FileExists won´t find the string, MyFilePath, when I run it with the IF/Loop. (getdirsubparentpath is a function)
Dim week, UserName As String
Dim MyFile, MyFilePath As String
Dim version As Integer
' Current week, XX
week = Format(Date, "ww")
' Username, e.g. niclas.madsen
UserName = Environ$("UserName")
' Initials, first letter of last and surname to caps
' e.g. niclas.madsen would be NM
UserName = UCase(Left(UserName, 1) & Mid(UserName, InStr(UserName, ".") + 1, 1))
' fix filename for saving purpose
MyFile = Replace(Replace("SupplierOrganization_W", "", ""), ".", "_") _
& "" _
& week _
& " " _
& UserName _
& ".csv"
'SupplierOrganization_WXX NM
MyFilePath = getDirSubParentPath & MyFile
' Look for the MyFilePath, if it exists then
' Add "-1" after the week number, if 1 exists, add 2, etc.
If Len(Dir(MyFilePath)) <> 0 Then
version = 0
Do
version = version + 1
MyFilePath = Dir(getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv")
Loop Until Len(Dir(MyFilePath)) < 0
End If
Dim tmpFile, tmpFilePath As String
tmpFile = getDirSubParentPath & "tmp_file.txt"
Dim tmpString As String
'Dim fso As New FileSystemObject
Dim fso As Object 'scripting.filesystemobject
Set fso = CreateObject("scripting.filesystemobject")
If fso.FileExists(MyFilePath) = True Then
Application.ScreenUpdating = False
Open MyFilePath For Input As #1
Open tmpFile For Output As #2
tmpString = Input(LOF(1), 1) 'read the entire file
tmpString = Replace(tmpString, (Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34)), "") 'eliminate double quotation and commas in the first line with UTF-8
Print #2, tmpString 'output result
Close #1
Close #2
fso.DeleteFile (MyFilePath) 'delete original file
fso.CopyFile tmpFile, MyFilePath, True 'rename temp file
fso.DeleteFile (tmpFile) 'delete temp file
Application.ScreenUpdating = True
MsgBox "Finished processing file", vbInformation, "Done!"
Else
MsgBox "Cannot locate the file : " & MyFilePath, vbCritical, "Error"
End If
Set fso = Nothing
End Sub
' Get Parent Sub Directory Path
Function getDirSubParentPath()
getDirSubParentPath = ThisWorkbook.Path & Application.PathSeparator & "CSV" & Application.PathSeparator & "Parent" & Application.PathSeparator
End Function
I finally manage to create a solution that seems viable. However, the code could use some cleaning up :) But it gets the job done.
So basically, I am having some issues with the loop. It will return a file named W16-0 (which should actual just be W16). It should only add the "-X" if W16 is found. So the incremental order should be W16, W16-1, W16-2, etc.
What I am doing is that I try to locate if there is a W16-0 and then replace it with W16. Furthermore, it seems like the loop will give me one higher than the amount of files I have. So that is where I also got an error. So if I had a W16-4, it would ask the macro to find and open a file named W16-5, which would obviously not exist.
If somebody could help me clean up the code, I would be really thankful!
Sub RemoveCommasDoubleQ()
'
' Enable a reference to 'Microsft Scripting Runtime'
' under VBA menu option Tools > References
Dim week, UserName As String
Dim MyFile, MyFilePath As String
Dim version As Integer
Dim fso As Object 'scripting.filesystemobject
Set fso = CreateObject("scripting.filesystemobject")
' Current week, XX
week = Format(Date, "ww")
' Username, e.g. niclas.madsen
UserName = Environ$("UserName")
' Initials, first letter of last and surname to caps
' e.g. niclas.madsen would be NM
UserName = UCase(Left(UserName, 1) & Mid(UserName, InStr(UserName, ".") + 1, 1))
' fix filename for saving purpose
MyFile = Replace(Replace("SupplierOrganization_W", "", ""), ".", "_") _
& "" _
& week _
& " " _
& UserName _
& ".csv"
'SupplierOrganization_WXX NM
'MyFilePath = ThisWorkbook.Path & "\CSV\Parent\" & MyFile
MyFilePath = getDirSubParentPath & MyFile
Debug.Print MyFilePath
Debug.Print "BEFORE LOOP"
'version = 1
Do While Len(Dir(MyFilePath)) <> 0
'// If it does, then append a _000 to the name
'// Change _000 to suit your requirement
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv"
'// Increment the counter
version = version + 1
'// and go around again
If MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-0" & " " & UserName & ".csv" Then
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & " " & UserName & ".csv"
Debug.Print MyFilePath
Debug.Print "IF LOOP"
End If
Loop
Debug.Print MyFilePath
Debug.Print "LOOP"
If fso.FileExists(getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv") = False Then
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version - 2 & " " & UserName & ".csv"
MsgBox getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv"
End If
fileName = fso.GetFileName(MyFilePath)
Debug.Print fileName
If MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-0" & " " & UserName & ".csv" Then
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & " " & UserName & ".csv"
Debug.Print MyFilePath
Debug.Print "her it should be 0"
End If
If MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & " " & UserName & ".csv" Then
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv"
End If
Debug.Print "HER ER VI"
fileName = fso.GetFileName(MyFilePath)
Debug.Print fileName
Dim tmpFile, tmpFilePath As String
tmpFile = getDirSubParentPath & "tmp_file.txt"
Dim tmpString As String
Debug.Print "------"
Debug.Print MyFilePath
If fso.FileExists(getDirSubParentPath & "SupplierOrganization_W" & week & "-0" & " " & UserName & ".csv") = True Then
MsgBox "Found the W-0"
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & " " & UserName & ".csv"
End If
Debug.Print "Found 0?"
Debug.Print MyFilePath
If fso.FileExists(MyFilePath) = True Then
Application.ScreenUpdating = False
Open MyFilePath For Input As #1
Open tmpFile For Output As #2
tmpString = Input(LOF(1), 1) 'read the entire file
tmpString = Replace(tmpString, (Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34)), "") 'eliminate double quotation and commas in the first line with UTF-8
Print #2, tmpString 'output result
Close #1
Close #2
fso.DeleteFile (MyFilePath) 'delete original file
fso.CopyFile tmpFile, MyFilePath, True 'rename temp file
fso.DeleteFile (tmpFile) 'delete temp file
Application.ScreenUpdating = True
MsgBox "Finished processing file", vbInformation, "Done!"
Else
MsgBox "Cannot locate the file : " & MyFile, vbCritical, "Error"
End If
Set fso = Nothing
End Sub

VBA escaping characters in formula

I have a formula which hardcoded should look like this:
=SUMMEWENNS(Rawdata!K2:K3446;Rawdata!I2:I3446;"bezahlt";Rawdata!A2:A3446;">="&DATWERT("18.03.2013 00:00");Rawdata!A2:A3446;"<="&DATWERT("24.03.2013 23:59"))
I want to add the formula via VBA into different cells and have come up with this string, but there is a syntax problem and I cannot find the error. It most likely has to do with the escaping of the characters espacially with the "DATWERT".
qq = Chr(34)
Cells(5, fieldextsales).FormulaLocal = "=SUMMEWENNS(RawData!K2:K" & _
maxnumrows & ";Rawdata!I2:I" & maxnumrows & ";" & qq & _
"bezahlt" & qq & ";Rawdata!A2:A" & maxnumrows & ";" & _
qq & ">= " & DATWERT(weekstart & " 00:00") * 1 & qq & _
";RawData!A2:A" & maxnumrows & ";" & qq & "<= " & _
DATWERT(weekend & " 23:59") * 1 & qq & ")"
Could anybody help me out? Hope I get the hang of it then.
Thx
Here we go:
"=SUMMEWENNS(RawData!K2:K" & _
maxnumrows & ";Rawdata!I2:I" & maxnumrows & ";" & _
"""bezahlt""" & ";Rawdata!A2:A" & maxnumrows & ";" & _
""">=""&DATWERT(""" & weekstart & " 00:00"")" & _
";RawData!A2:A" & maxnumrows & ";" & _
"""<=""&DATWERT(""" & weekend & " 23:59""))"
From the VBA side you use plain English function names, not local names => DATWERT shoud be DateValue, unless you want to embed it into your formula.