I'm trying to write an if statement that includes a VLOOKUP, ISBLANK, and ISERROR, AND separate sheets.
=IFERROR(VLOOKUP(F2,'Sheet2'!$S$1:$T$9999,2,FALSE),"Scrub")
The above formula is working fine except that when column F is blank it enters "Scrub". I want to add an ISBLANK statement so that if Column F is blank it returns a blank. I know to get a blank return I enter "" but I can't seem to get it to work. I keep getting the too many arguments error.
I want to automate modelling of network in OMNET++ as creating network manually everytime is difficult. The input to OMNET++ will be the Excel file having Channels and ECU names per channel. Is there any way to import excel into NED language, I didn't find anything like this in OMNET NED documentation.I tried creating template in python also as mention in the linked answer but that didn't solved my purpose. Does anyone have any other idea by which this can be done??
Excel file looks like
I am trying to write a VBA script that works as a macro for an Excel file and translates this to an XML file. This I have been able to achieve however it needs to check its own data on the fly to prevent double notations. The data is sorted based on a marker called a tagname. There exists the possibility that a certain tagname exist more than once.
What I would like to be able to do is parse the XML document that is being created based on this tagname and when a node with this tagname is found, the additional information should be appended to the info attribute of this node.
Currently, the XML hat is being produced looks like this:
<Section name="GS.0101PS02">
<Translation key="Info">=GS+MCC-151B9 Filterbewaking</Translation>
</Section>
<Section name="GS.0102PS02">
<Translation key="Info">=GS+MCC-152B3 Filterbewaking</Translation>
</Section>
<Section name="GS.0025LS01">
<Translation key="Info">=GS+MCC-161B5 Niveau opvangbak</Translation>
</Section>
<Section name="GS.0026LS01">
<Translation key="Info">=GS+MCC-161B15 Niveau opvangbak</Translation>
</Section>
<Section name="GS.0300PS02">
<Translation key="Info">=GS+MCC-162B11 Filterbewaking</Translation>
</Section>
<Section name="GS.0141AV05">
<Translation key="Info">=GS+CC1-150B3 Bunker 1 Eindklep Open <br/> =GS+CC1-150B5 Bunker 1 Eindklep Dicht</Translation>
</Section>
The last line is an example of the tagname that exists multiple times throughout the document and this is also how it should be formatted. Currently the code is only capable of doing this when the tagname repeats itself in the next row, however, this is not a given.
I have attempted realizing this using selectnodes() and selectsinglenode() and a couple other approached but have been unsuccessful the main reason I can think of is that my my XPath if formatted improperly.
The script I am running is as follows:
Sub RPCTranslatesCombinedInfoBackwardsChecking()
Set oXMLDoc = CreateObject("MSXML2.DOMDocument") 'Create the XML document'
Set oPI = oXMLDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""") 'Define the processing instructions'
Set oRoot = oXMLDoc.CreateNode(1, "Translations", "urn:Riwo.Pcs.Localization") 'Create the root node "Translations" in the name space urn:Riwo.Pcs.Localization'
Set xsi_Attribute = oXMLDoc.CreateAttribute("xmlns:xsi") 'Add the first attribute to the namespace'
xsi_Attribute.Value = "http://www.w3.org/2001/XMLSchema-instance"
oRoot.Attributes.setNamedItem (xsi_Attribute)
Set xsd_Attribute = oXMLDoc.CreateAttribute("xmlns:xsd") 'Add the Second attribute to the namespace'
xsd_Attribute.Value = "http://www.w3.org/2001/XMLSchema"
oRoot.Attributes.setNamedItem (xsd_Attribute)
Set code_Attribute = oXMLDoc.CreateAttribute("code") 'Add the Third attribute to the namespace'
code_Attribute.Value = "nl"
oRoot.Attributes.setNamedItem (code_Attribute)
Set description_Attribute = oXMLDoc.CreateAttribute("description") 'Add the Fourth attribute to the namespace'
description_Attribute.Value = "Dutch"
oRoot.Attributes.setNamedItem (description_Attribute)
oXMLDoc.AppendChild oRoot 'Append the above defined node to the document'
oXMLDoc.InsertBefore oPI, oXMLDoc.ChildNodes.Item(0)
With ActiveSheet
lRow = 2 'Start the macro operation at the second row of the active worksheet'
sSectionName = ""'Initialize the sectionname string'
Do While .Cells(lRow, 4).Value <> ""'While there is a value in the fourth colom, starting at row 2'
sLineName = .Cells(lRow, 1).Value 'Define a prefix for the section names'
sSectionPrefix = Right(sLineName, Len(sLineName) - 1)
Passes = 0
sSectionName = .Cells(lRow, 4).Value 'Define the value of row x in colom 4 as the section name'
Set oElmSection = oXMLDoc.CreateNode(1, "Section", "urn:Riwo.Pcs.Localization") 'Create the section node'
oXMLDoc.DocumentElement.AppendChild oElmSection 'Append the section node to the document'
Set oAttr = oXMLDoc.CreateNode(2, "name", "urn:Riwo.Pcs.Localization") 'Add the name attribute to the section node'
NodeName = sSectionPrefix & "."& sSectionName
oAttr.NodeValue = NodeName 'Define the name of the section node as being the prefix aswel as the section name from the fourth colom'
oElmSection.SetAttributeNode oAttr 'Set the name attribute as an attribute of section'
ExistingNodes = oXMLDoc.SelectNodes("//Section").Attributes.getNamedItem([@name=NodeName]).Text
Do While .Cells(lRow, 4).Value = sSectionName 'For all sections with the same section name do:'
sInfoDescription_1 = .Cells(lRow, 1).Value 'Fetch the info data for the respective row'
sInfoDescription_2 = .Cells(lRow, 2).Value
sInfoDescription_3 = .Cells(lRow, 3).Value
sInfoDescription_5 = .Cells(lRow, 5).Value
If Passes = 0 Then 'Check if first pass of the section"
sInfo = sInfoDescription_1 & sInfoDescription_2 & sInfoDescription_3 & ""& sInfoDescription_5 'Combine info in 1 string'
Set oElmTranslation = oXMLDoc.CreateNode(1, "Translation", "urn:Riwo.Pcs.Localization") 'Create Translation node'
Set oAttr = oXMLDoc.CreateNode(2, "key", "urn:Riwo.Pcs.Localization") 'Add key attribute'
oAttr.NodeValue = "Info"'Define Info as key'
oElmTranslation.SetAttributeNode oAttr 'Set key attribute in Translation node'
oElmTranslation.AppendChild oXMLDoc.createTextNode(sInfo) 'Use info text as info'
oElmSection.AppendChild oElmTranslation 'Append Translation node to section'
Passes = 1
lRow = lRow + 1 'Procede to next row'
Else 'Second or more passes over a section'
sInfo = "<br/> "& sInfoDescription_1 & sInfoDescription_2 & sInfoDescription_3 & ""& sInfoDescription_5 'Combine info in 1 string'
oElmTranslation.AppendChild oXMLDoc.createTextNode(sInfo) 'Use info text as info'
lRow = lRow + 1 'Procede to next row'
End If
Loop 'Loop second while'
Loop 'Loop first while'
End With
MsgBox oXMLDoc.XML 'Show result'
oXMLDoc.Save "C:\Users\thomas.RIWO\Desktop\Translations\RPC test\test2.xml"'Save the xml file'
End Sub
What I would like to know is how to retrieve an existing node from my xml and edit this.
Need help on this. I have combobox which links to sheet that will show default value based on Column A value. Example,
A| Twinkle Star | BY Ali
B| ABC Song | By Kim
C| 123 Song | By Els
If i choose A, in userform will shows the twinkle star and by ali in text box. I would like to set if A is chosen, it will play Twinkle Star song, when B is chosen, it wil play ABC Song. Need your opinion please.
Private Sub UserForm_Initialize()
Set xRg = Worksheets("Sheet4").Range("A2:C7")
Me.ComboBox1.List = xRg.Columns(1).Value
End Sub
Private Sub ComboBox1_Change()
Me.TextBox1.Text = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, xRg, 2, False)
Me.TextBox2.Text = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, xRg, 3, False)
Select Case ComboBox1.Value
Case "A"
WindowsMediaPlayer1.Controls.Play= FollowHyperlink "#Sheet4!A2"
Case "B"
WindowsMediaPlayer1.Controls.Play= FollowHyperlink "#Sheet4!A3"
End Select
End Sub
i tried using case a, b and links to hyperlink but not works.. appreciate your help guys.
I'm trying to send form data through the XMLHTTP object to get a webpage.
I am using Excel 2010.
The website is http://espn.go.com/mlb/players.
I'm trying to search for a certain player through the searchbox (e.g. Fister).
Here is the source code between the form tags.
<form id="searchBox" name="searchBox" action="http://search.espn.go.com/results" method="get" accept-charset="utf-8" style="color: #999999;">
<div class="clearfix">
<input autocomplete="off" class="text" type="text" placeholder="Search" name="searchString" id="searchString" />
<input type="hidden" name="page" id="page" value="null" />
<input type="hidden" name="fromForm" value="true" />
<input class="submit" type="submit" value="" />
</div>
</form>
My code.
Sub SearchPlayer()
Dim xml As MSXML2.ServerXMLHTTP
Dim search, url As String
search = "searchString=Fister&page=null&fromForm=true"
url = "http://espn.go.com/mlb/players"
Set xml = New MSXML2.ServerXMLHTTP
xml.Open "POST", url, False
xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xml.send search
MsgBox xml.responseText
Set xml = Nothing
End Sub
I have a userform with eight option buttons representing search criteria for seven possible items. The user selects one criteria to search for results and an inputbox appears asking the user to enter a keyword. My worksheets are the names of the seven possible items. But not every worksheet has all eight search criteria options (actually none of them have all eight of them).
These option buttons represent column headings across multiple worksheets. How can I write a code to take the selected option button (say OptionButton1) and the keyword (say Keyword) from the InputBox and return results from a worksheet (the worksheet with the name = keword). The keyword must be one of the possible items or else I need to MsgBox an error to let them try again.
I am thinking:
Dim Keyword as variant
Keyword = InputBox("please enter a keyword")
If Keyword = Item1 or Item2 or ...Item 3 Then
Worksheet(Keyword).Activate
If OptionButton1.Value = True and OptionButton1.Value = 'any column headings in the selected worksheet' Then
'return the entire row results of items with that selected option button column heading and the keyword'
ElseIf OptionButton2.Value = True and .... Then
'do the same thing
ElseIf OptionButton3.Value...
End If
Else
MsgBox ("Please enter a valid keyword")
End If
Is it possible to export specific row in MySQL to excel? All I found in the internet is whole table exported. How about per line?
Is there any way in Excel to convert the timestamp in the format
{"_seconds":1570448585,"_nanoseconds":834000000}
to readable format (Human-friendly)?
1-Oct-2018 12:00 PM
I'm looking for a way to save a PDF file from an Outlook Mail to a the Temp folder of the user to work with it.
I did this some time back in C#, but it seems like VBA cant handle the Drag and Drop with outlook Files.
So I have a UserForm in my Excel file. In this Form is a ListView. I can Drag and Drop files From the explorer write the path of the file into a sheet. So I want to do the same with an PDF File from an attachment from Outlook. But I cant find a way to save the PDF to a folder.
Is there a way to do this with the Drag and Drop event from the ListView?
I'm trying to extract data from a table which is deep down in html code. So, if I try to get it using simply getElementsByClassName() or getElementById() methods it ends up with Nothing.
So I'm trying to get it piece by piece. So, here's the snippet I'm working on:
Set Doc = ie.Document
Set iframeDoc = Doc.frames("uft-RB").Document
Debug.Print iframeDoc.body.contains(iframeDoc.getElementsByClassName("UFTPanel")(0)) 'True
Debug.Print iframeDoc.body.innerHTML
Set divDoc = iframeDoc.getElementsByClassName("UFTPanel")(0).Document
Debug.Print divDoc.body.innerHTML
And the output I'm getting for both of the Debug.Print are same:
<!-- gwt bootstrap -->
<script language="javascript" src="takexyz"></script>
<iframe id="takeefg" style="border: 0px currentColor; width: 0px; height: 0px;"></iframe>
<iframe tabIndex="-1" id="takeabc" style="border: currentColor; left: -1000px; top: -1000px; width: 0px; height: 0px; position: absolute;"></iframe><div class="UFTPanel"></div>
And I couldn't get the content inside the <div class="UFTPanel">.
I want to have an url in single cell (A1).
My DataFrame is from python dict and it's without this url. But I have it under variable url. I've tried df.iat and it did not work.
df = pandas.DataFrame(data=collection)
df = df.sort_index(ascending=False)
df.to_excel(writer, sheet_name=sheetname)
df.iat[0, 0] = url
On picture, I've markup where the url should be.
Any ideas ?
Below code is working fine only one thing is missing is that the code doesn't go to the searched tab in IE.
With CreateObject("Shell.Application").Windows
If .Count > 0 Then
Set IE = .Item(0)
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next
my_url = objShell.Windows(x).document.Location
If my_url Like Sheets("Transfer Agency").Range("AB1") & "*" Then
Set IE = objShell.Windows(x)
'**How to activate/select the searched tab in IE**
Exit For
Else
End If
Next
Else
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate Sheets("Transfer Agency").Range("AB1"), CLng(2048)
Set IE = Nothing
End If
End With
Using vbScript, I use the find method to search a named range for a cell value and select that item in the worksheet if the value is found. What I need to do is select a range of cells starting with the "found" cell and extending to the top row in the column and from the found cell to the bottom of the column. So, if my found cell is A15 then I want to select the range that is A14 through A1 and from A16 to the bottom of the column. I've been kicking this can down the road far to long. Can someone help. Thanks in advance.
Can someone please help me with creating the vba code
A B C D
1jobid dep job_no Sequence
2 aaa FJ 1 1
3 aaa FJ 1 2
4 aaa FJ 1 3
5 aaa RJ 1 1
6 aaa RJ 1 2
7 aaa RJ 1 3
8 aaa RJ 1
9 aaa FJ 1
What I want to do is to find the cell address of the cell which is empty in column D when the jobid, dep, jobno are the conditions and store it in a variable for later use.
Example:
for jobid=aaa and dep=rj and job_no=1 return D8
i'm new to vba and excel also,i created a database in excel and these two codes are essential for my project to work.. i want to run these vba codes in the same time, can you help me merge the code and make it work, please? i tried by myself but nothing worked.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Item As String
Dim SearchRange As Range
Dim rFound As Range
'Don't run the macro if:
'Target is not a single cell:
If Target.Cells.Count > 1 Then Exit Sub
'or Target belongs to the A1.CurrentRegion:
If Not Intersect(Target, Range("A1").CurrentRegion) Is Nothing Then Exit Sub
'Avoid the endless loop:
Application.EnableEvents = False
'Looks for matches from the here first:
Set SearchRange = Range("A1:A"& Range("A1").CurrentRegion.Rows.Count)
Item = Target.Value
'Clears the Target:
Target.Value = ""
If Application.WorksheetFunction.CountIf(SearchRange, Item) > 0 Then
'There's a match already:
Set rFound = Columns(1).Find(What:=Item, After:=Cells(1, 1) _
, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'Adds one to the Quantity:
rFound.Offset(0, 2).Value = rFound.Offset(0, 2).Value + 1
Else
'Writes the value for the Barcode-list:
Range("A"& SearchRange.Rows.Count + 1).Value = Item
'Looks for the match from sheet "Inventory" column A
With Sheets("Inventory")
Set rFound = .Columns(1).Find(What:=Item, After:=.Cells(1, 1) _
, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
On Error GoTo 0
If Not rFound Is Nothing Then
'Writes the Product Name and puts 1 to the Quantity column:
Range("B"& SearchRange.Rows.Count + 1).Value = rFound.Offset(0, 1).Value
Range("C"& SearchRange.Rows.Count + 1).Value = 1
End If
End With
End If
'Enable the Events again:
Application.EnableEvents = True
End Sub
and the second one:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 3 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
With Target.Offset(0, 3)
.Value = Now
.NumberFormat = "DD/MM/YYYY"
End With
End Sub
I'm trying to set a DataLabel of a chart point in VBA, and cant find the way to do it. In the last part of this code I set up the properties of the chart's point, but I don't know how to set up a custom position, I attach a picture of the result I'm trying to have:
objCht.Chart.SetSourceData Source:=ResBook.Sheets(Right(NombreHoja, 2)).Range("P1:R"& UltFilaGrafico)
objCht.Activate
Call AgregarEjeSecundario("Velocidad [km/h]", 3)
ActiveChart.Axes(xlValue, xlSecondary).Select
ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = CInt(TargetVelocity) + 10
ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = 0
ActiveChart.Legend.Position = xlLegendPositionBottom
'ActiveChart.SeriesCollection(2).Points(50).MarkerStyle = xlDiamond
With ActiveChart.SeriesCollection(1)
'.Points(StopEventRow).MarkerStyle = xlDiamond
.Points(StopEventRow).MarkerStyle = xlMarkerStyleTriangle
'.Points(StopEventRow).MarkerSize = 10
.Points(StopEventRow).MarkerBackgroundColor = RGB(255, 0, 0) 'Rojo
.Points(StopEventRow).MarkerForegroundColor = RGB(1, 1, 1)
.Points(StopEventRow).HasDataLabel = True
.Points(StopEventRow).DataLabel.text = "Detención"'.Points(StopEventRow).ApplyDataLabels Type:=xlValue
.Points(StopEventRow).DataLabel.Font.ColorIndex = 3
'.Points(StopEventRow).DataLabel.Position = xlLabelPositionCustom
'.Points(StopEventRow).ApplyDataLabels Type:=xlShowLabel
End With
This is what I'm trying to accomplish through the VBA code.
Here I manually set up the position of the label, I´m trying to get this done by the code
I am trying to unzip a .tar file using VBA. I have googled it to find the answer, but not many article talk about the unzipped . tar file.
The code I refer is below : from here: https://www.rondebruin.nl/win/s7/win002.htm because I want to unzipped the .tar file.
Step 1, I changed the below code to from .zip to .tar or .tar.gz
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
it found the file, but I failed in below line:
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
The error was:
run-time error'-214767259(80004005)':Method 'NameSpace' of object 'IsheLLdispatch6' failed.
Below the code I refer for unzipped zip file.
Sub Unzip3()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
'Destination folder
DefPath = "C:\Users\Ron\test\"'<<< Change path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
FileNameFolder = DefPath
''Delete all the files in the folder DefPath first if you want
' On Error Resume Next
' Kill DefPath & "*.*"' On Error GoTo 0
'Extract the files into the Destination folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
MsgBox "You find the files here: "& FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
Edit:
Sub ExtractAllFiles()
Dim File As String
Dim ShellStr
File = Dir("C:\test")
While (File <>"")
if Instr(1,File,".tar")>0 then
ShellStr = "C:\Program Files\PKWARE\PKZIPW -e C:\test\ "& File & _
" C:\test\"
Call Shell(ShellStr, vbHide)
End if
File = Dir
DoEvents
Loop
End Sub
current_version from a kind person in the different forum. i got the error message: run-time error 5 invalid procedure call or argument
Function Quoted(s As String)
Quoted = Chr(34) & s & Chr(34) 'Chr(34)
End Function
Sub ExtractAllFiles()
Dim workDir As String: workDir = "C:\test\"
Dim appPath As String: appPath = "C:\Program Files\PKWARE\PKZIPW"
Dim tarFilename As String: tarFilename = Dir(workDir & "*.tar")
While tarFilename <> ""
Dim tarPath As String: tarPath = workDir & tarFilename
Dim shellCmd As String: shellCmd = Quoted(appPath) & " -e "&
Quoted(tarPath) & ""& Quoted(workDir)
Call Shell(shellCmd, vbHide)
tarFilename = Dir
DoEvents
Wend
End Sub
I am attempting to create message boxes based on if the 'txtTravelDate' field in my userform has a date, but for some reason this is not working properly. Everything was working fine until I added this piece and now I am receiving a runtime error 13-type mismatch on this line of coding:
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 14).value = CDec(txtLodging) 'lodging
Everything was working fine in all of the coding shown below and then I added the line regarding the txtTravelDate having a value... I do not understand why this different field would suddenly throw an error. Can anyone help me? All code is shown below:
Public Sub cmdSubmit_Click()
'When submit button is clicked
Dim TargetRow As Integer
Dim TravelTargetRow As Integer
TargetRow = Sheets("Codes").Range("D43").value + 1
txtTravelDate = format(txtTravelDate, "mm/dd/yyyy")
txtDepartTime = format(txtDepartTime, "hh:mm am/pm")
txtArrivalTime = format(txtArrivalTime, "hh:mm am/pm")
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow).EntireRow.Copy
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow + 1).EntireRow.Insert
Application.CutCopyMode = False
'''ERROR MESSAGES PRESENTED WHEN SUBMIT IS SELECTED'''
If txtTravelDate.value <> "" And txtDepartTime.value = "" Then
MsgBox "You must enter Actual Departure Time. If this was overnight travel, and you traveled the previous day to your destination, enter 12:01 AM", vbCritical
Exit Sub
End If
If txtTravelDate.value <> "" And txtArrivalTime.value = "" Then
MsgBox "You must enter Actual Arrival Time. If this is an overnight trip and you will not return home today, please enter 12:00 PM", vbCritical
Exit Sub
End If
If txtTravelDate.value <> "" And cmbOVNRTN.value = "" Then
MsgBox "You must select if these expense reimbursements are for Overnight travel or same day Return", vbCritical
Exit Sub
End If
If txtTravelDate.value <> "" And Sheets("Travel Expense Voucher").Range("D5").value = 1 And txtProjectNumber.value = "" Then
MsgBox "You must provide a valid Project Number", vbCritical
Exit Sub
End If
If txtTravelDate.value <> "" And cmbInOutState.value = "" Then
MsgBox "You must select if this travel was 'In-State' or 'Out-of-State'", vbCritical
Exit Sub
End If
If txtTravelDate.value <> "" And txtMilesTraveled.value = "" Then
MsgBox "You must enter total miles traveled to be eligible for any reimbursement amounts", vbCritical
Exit Sub
End If
If txtTravelDate.value <> "" And cmbMileageRates.value <> "" And cmbTravelMode.value = "" Then
MsgBox "You must select Mode of Travel to be eligible for mileage reimbursement."
Exit Sub
End If
If txtTravelDate.value <> "" And txtTrvlDetails.value = "" Then
MsgBox "You must provide Travel Details/Description and Business Purpose for this trip", vbCritical
Exit Sub
End If
'''BEGIN DATA MOVE INTO DATABASE'''
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 0).value = txtTravelDate 'travel date
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 1).value = txtDepartTime 'departure time
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 2).value = txtArrivalTime 'arrival time
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 3).value = cmbOVNRTN 'overnight or return
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 10).value = txtProjectNumber 'project number
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 9).value = cmbInOutState 'in-state or out-of-state
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 8).value = cmbTravelMode 'travel mode
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 12).value = txtMilesTraveled 'mileage
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 11).value = cmbMileageRates 'mileage rate
**Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 14).value = CDec(txtLodging) 'lodging**
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 15).value = chkMorning 'morning meal
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 16).value = chkMidday 'midday meal
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 17).value = chkEvening 'evening meal
Sheets("Travel Expense Voucher").Range("Data_Start").Offset(TargetRow, 4).value = txtTrvlDetails 'travel details/business purpose
'''END DATA MOVE INTO DATABASE''''''OTHER EXPENSES SECTION''
Dim OtherTargetRow As Integer
OtherTargetRow = Sheets("Codes").Range("D44").value + 1
'txtOtherDollarAmt = format(txtOtherDollarAmt, "$#,##0.00")
txtOtherDate = format(txtOtherDate, "mm/dd/yyyy")
'Error messages presented when submit is selected
If Sheets("Travel Expense Voucher").Range("D5").value = 1 And txtOtherProjectNum.value = "" Then
MsgBox "You must provide a valid Project Number", vbCritical
Exit Sub
End If
If txtOtherExpenseDescription.value = "" Then
MsgBox "You must provide Expense Description/Business Purpose for this expense", vbCritical
Exit Sub
End If
If cmbOtherExpenseCode.value = "" Then
MsgBox "You must select an expense code from the drop-down menu", vbCritical
Exit Sub
End If
'''BEGIN DATA MOVE INTO DATABASE'''
Sheets("Travel Expense Voucher").Range("OtherExpensesData_Start").Offset(OtherTargetRow, 0).value = txtOtherDate 'other expense date
Sheets("Travel Expense Voucher").Range("OtherExpensesData_Start").Offset(OtherTargetRow, 1).value = txtOtherProjectNum 'Other Project Number
Sheets("Travel Expense Voucher").Range("OtherExpensesData_Start").Offset(OtherTargetRow, 2).value = txtOtherExpenseDescription 'Other Expense Description
Sheets("Travel Expense Voucher").Range("OtherExpensesData_Start").Offset(OtherTargetRow, 8).value = cmbOtherExpenseCode 'Other Expense Code
Sheets("Travel Expense Voucher").Range("OtherExpensesData_Start").Offset(OtherTargetRow, 9).value = CDec(txtOtherDollarAmt) 'Other Expense Dollar Amount
'''END DATA MOVE INTO DATABASE'''
MsgBox "Travel and expense entry for "& txtTravelDate & " is complete. Select the 'Add' button to add another day of travel.", 0, "Complete"
Unload frmUserTravel
End Sub
I'm trying to run a simple query from Excel to newer version of SQL Server. I have done this many times in the past, but it was always to a standard SQL Server DB. Now, I'm working with a new animal, which is Azure SQL Server Data Warehouse. I am using very generic VBA code to connect to the DW.
Sub TryMe()
'Initializes variables
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim ConnectionString As String
Dim StrQuery As String
pswd = "my_pwd"
user = "my_used_ID"
dbName = "my_DB_name"
server = "server_name.database.Windows.net"'Setup the connection string for accessing MS SQL database
'Make sure to change:
'1: PASSWORD
'2: USERNAME
'3: REMOTE_IP_ADDRESS
'4: DATABASE
ConnectionString = "Provider=SQLOLEDB;Password=pswd;User ID=user;Data Source=server;Use Encryption for Data=False;Initial Catalog=dbname"'Opens connection to the database
cnn.Open ConnectionString
'Timeout error in seconds for executing the entire query; this will run for 15 minutes before VBA timesout, but your database might timeout before this value
cnn.CommandTimeout = 900
'This is your actual MS SQL query that you need to run; you should check this query first using a more robust SQL editor (such as HeidiSQL) to ensure your query is valid
StrQuery = "SELECT TOP 10 * FROM myBigTable"'Performs the actual query
rst.Open StrQuery, cnn
'Dumps all the results from the StrQuery into cell A2 of the first sheet in the active workbook
Sheets(1).Range("A2").CopyFromRecordset rst
End Sub
It should be a pretty straightforward thing, but I keep getting an error message that says: 'SQL Server does not exist or access is denied'.
The error occurs on this line:
cnn.Open ConnectionString
I set a reference to Microsoft ActiveX Data Objects 2.0 Library.
Has anyone tried this and actually gotten this to work?
The error is in excel 2010, which earlier worked fine. The same file when opened on excel 2016 works.