|
Have you tried
For i as integer = 0 to R1200s.Rows.Count-1
Next i
|
|
|
|
|
Hi,
I try to create an access 2007 or higher file.
I wrote this testcode just an simple form with 2 buttons.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles btnMake.Click
Dim dlg As New SaveFileDialog
With dlg
.Filter = "Access(.accdb)|.accdb"
If .ShowDialog = DialogResult.OK Then
Dim cat As New ADOX.Catalog()
Try
cat.Create("Provider=Microsoft.ACE.OLEDB.102.0;Data Source=" & .FileName & ";Persist Security Info=True")
'cat.Create("Driver={Microsoft Access Driver (*.mdb, *.accdb)};DBQ=" & .FileName)
Catch ex1 As Exception
MsgBox(ex1.Message)
If MsgBox("Is Microsoft Access Database Engine 2010 Redistributable installed?", vbQuestion Or MsgBoxStyle.YesNo) = MsgBoxResult.No Then
Try
Process.Start("<a href="https://www.microsoft.com/en-us/download/details.aspx?id=13255">https://www.microsoft.com/en-us/download/details.aspx?id=13255</a>")<br />
MsgBox("Do it :)", MsgBoxStyle.SystemModal)
Catch ex2 As Exception
End Try
End If
Finally
cat = Nothing
End Try
End If
End With
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles btnOpen.Click
Dim dlg As New OpenFileDialog
With dlg
.Filter = "Access(.accdb)|.accdb"
If .ShowDialog = DialogResult.OK Then
Dim OLEConnection As New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & .FileName & ";Persist Security Info=True")
OLEConnection.Open()
Dim OLECommand As New OleDb.OleDbCommand("", OLEConnection)
' Before this line you can create a string that holds your build for the table structure
Randomize()
Dim t As Int64 = Int(Rnd() * 100000)
Try
OLECommand.CommandText = "CREATE TABLE mytable" & t & " (field1 CHAR,field2 NUMBER)"
OLECommand.ExecuteNonQuery()
MsgBox("Table " & t & " maded")
OLECommand.CommandText = "insert into mytable" & t & " values(""" & t & """, " & t & ")"
OLECommand.ExecuteNonQuery()
OLECommand.Connection.Close()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End If
End With
End Sub
Create a table works. However making a file Always fails.
Can anyone gives me idaes?
I've tryed installing the 32 and 64 bit version of Microsoft Access Database Engine 2010 Redistributable
I'm working on a W10 machine 64bit
Jan
|
|
|
|
|
You are missing quite a bit of logic in creating the database. The sequence of events should be:
string connectionString = string.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0}", tbFilename.Text);
ADOX.Catalog cat = new ADOX.Catalog();
cat.Create(connectionString);
ADOX.Table adoxTable = new ADOX.Table();
adoxTable.Name = <table name here>
ADOX.DataTypeEnum dbType = <column data type>
adoxTable.Columns.Append(<column name>, dbType);
cat.Tables.Append(adoxTable);
ADODB.Connection con = cat.ActiveConnection as ADODB.Connection;
con.Close();
|
|
|
|
|
Thanks both for the help.
My sequence is the same as yours 
Make file
add table
The difference is for making the tables: I use sql.
But it seems that making files won't work with framework 2.
Now with only changing to 4.52 it works
Jan
|
|
|
|
|
|
Hi - I use the Yahoo Finance API, to get Stock Quotes. The following code is showing a Status of 504. Does this mean that the service is discontinued or that the server is temporarily down? Can anybody suggest an alternative - where the function takes input of Ticker and Date, and gives output of Closing Price? Please ignore the error checks I am doing in the function below, since this is part of a larger macro and excuse the amateurish programming skills!
Public Function StockQuote(strTicker As String, Optional dtDate As Variant)
' Date is optional - if omitted, use today. If value is not a date, throw error.
If IsMissing(dtDate) Then
dtDate = Date
Else
If Not (IsDate(dtDate)) Then
StockQuote = CVErr(xlErrNum)
End If
End If
Dim dtPrevDate As Date
Dim strURL As String
Dim strCSV As String
Dim strRows() As String
Dim strColumns() As String
Dim dbClose As Double
dtPrevDate = dtDate - 7 'need a previous date cos of API Service
' Compile the request URL with start date and end date
strURL = "http://ichart.finance.yahoo.com/table.csv?s=" & strTicker & _
"&a=" & Month(dtPrevDate) - 1 & _
"&b=" & Day(dtPrevDate) & _
"&c=" & Year(dtPrevDate) & _
"&d=" & Month(dtDate) - 1 & _
"&e=" & Day(dtDate) & _
"&f=" & Year(dtDate) & _
"&g=d&ignore=.csv"
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
http.Open "GET", strURL, False
http.Send
strCSV = http.responseText
' The most recent information is in row 2, just below the table headings.
' The price close is the 5th entry
If http.readystate = 4 Then
If http.Status = 200 Then
strRows() = Split(strCSV, Chr(10)) ' split the CSV into rows
strColumns = Split(strRows(1), ",") ' split the relevant row into columns. 1 means 2nd row, starting at index 0
dbClose = strColumns(4) ' 4 means: 5th position, starting at index 0
Else
dbClose = 0
GlobalErrorCount = GlobalErrorCount + 1
End If
Else
dbClose = 0
GlobalErrorCount = GlobalErrorCount + 1
End If
StockQuote = dbClose
Set http = Nothing
End Function
|
|
|
|
|
What this means is that the Yahoo servers did not get a response from the other service. You have less chance of fixing the problem at all, because it is in the hands of the network admins who are configuring the services at the back-end servers.
HTTP Status 504 - Stack Overflow
The sh*t I complain about
It's like there ain't a cloud in the sky and it's raining out - Eminem
~! Firewall !~
|
|
|
|
|
So admittedly I didn't write this code. I found it online and adjusted as I needed. We have been using this code to automatically create signatures and I have it running in several locations. Recently it has been failing to run on workstations in our office. They are all Windows 10 Pro, running office 2016 standard. The script runs fine on our terminal server which is server 2012 r2 with office 2016 standard.
Code fails seemingly at any line which contains objSelection.InlineShapes.AddPicture
If I comment out the first line containing that (line 124) the error happens on the next line containing it. Not sure if there was an update that broke this. Thanks for any help.
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strSignatureName = "default"
strLogoPath = "\\sersbs11\Common Shared Files\EMAILSIGS\seremailgraphic.jpg"
strGiven = objuser.givenName
strSurname = objuser.sn
strAddress1 = "6010 99 Street NW "
strAddress1EXT = objUser.postofficebox
strAddress2 = " Edmonton, AB "
strAddress3 = objuser.st
strPostcode = " T6E-3P2"
strExt = objuser.homephone
strTitle = objUser.title
strEmail =objuser.mail
strCompany = objUser.Company
strPhone = objUser.telephoneNumber
strFax = objUser.facsimileTelephoneNumber
strMobile = objuser.mobile
strDepartment = objUser.Department
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Style = "No Spacing"
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
objselection.TypeText Chr(11)
Const Number_of_rows = 4
Const Number_of_columns = 1
Const END_OF_STORY = 1
objSelection.TypeParagraph()
Set objRange = objSelection.Range
objDoc.Tables.Add objRange, number_of_rows, number_of_columns
Set objTable = objDoc.Tables(1)
objTable.AutoFitBehavior(1)
Set objCell = objTable.Cell(1, 1)
Set objCellRange = objCell.Range
objSelection.Range = objCell.Range
objSelection.Font.Name = "Arial"
objSelection.Font.Size = 11
objSelection.Font.Bold = True
objSelection.Font.Color = RGB (0,127,127)
objSelection.TypeText strGiven & " " & strSurname
objSelection.Font.Size = 8
Rem objSelection.Font.Bold = False
objSelection.TypeText strDepartment & Chr(11)
objSelection.Font.Name = "Arial"
objSelection.Font.Size = 9
objSelection.Font.Bold = True
objSelection.Font.Color = RGB (121,121,121)
objSelection.TypeText strTitle & Chr(11)
objSelection.Font.Name = "Arial"
objSelection.Font.Size = 9
objSelection.Font.Bold = False
objSelection.Font.Color = RGB (121,121,121)
if len(strPhone) > 5 and len(strMobile) > 5 then
objSelection.TypeText strEmail & Chr(11) & "P. " & strPhone & Chr(11) & "M. " & strMobile
else if len(strPhone) >5 then
objSelection.TypeText strEmail & Chr(11) & "P. " & strPhone
else if len(strMobile) >5 then
objSelection.TypeText strEmail & Chr(11) & "M. " & strMobile
else
objSelection.TypeText strEmail
end if
end if
end if
Set objCell = objTable.Cell(2, 1)
Set objCellRange = objCell.Range
objCell.Select
objSelection.InlineShapes.AddPicture(strLogoPath)
objSelection.Font.Name = "Arial"
objSelection.Font.Size = 9
objSelection.Font.Bold = False
objSelection.Font.Color = RGB (0,127,127)
if len(strext) = 3 then
objSelection.TypeText Chr(11) & strAddress1 & Chr(149) & strAddress2 & Chr(149) & strPostcode & " " & Chr(149) & " " &_
"P. 780.435.2211 Ext: " & strext & " " & Chr(149) & " F. 780.437.4964 "
else
objSelection.TypeText Chr(11) & strAddress1 & Chr(149) & strAddress2 & Chr(149) & strPostcode & " " & Chr(149) & " " &_
"P. 780.435.2211 " & Chr(149) & " F. 780.437.4964 "
end if
Set objCell = objTable.Cell(3, 1)
Set objCellRange = objCell.Range
objCell.Select
PicFile0 = "\\sersbs11\Common Shared Files\EMAILSIGS\space.png"
PicFile1 = "\\sersbs11\Common Shared Files\EMAILSIGS\facebook.png"
LinkFile1 = "http://www.facebook.com/specialeventrentals"
PicFile2 = "\\sersbs11\Common Shared Files\EMAILSIGS\twitter.png"
LinkFile2 = "http://www.twitter.com/seredmonton"
PicFile3 = "\\sersbs11\Common Shared Files\EMAILSIGS\wordpress.png"
LinkFile3 = "http://blog.specialeventrentals.com"
PicFile4 = "\\sersbs11\Common Shared Files\EMAILSIGS\youtube.png"
LinkFile4 = "http://www.youtube.com/user/specialeventrentals"
PicFile5 = "\\sersbs11\Common Shared Files\EMAILSIGS\www.png"
LinkFile5 = "http://edmonton.specialeventrentals.com"
PicFile6 = "\\sersbs11\Common Shared Files\EMAILSIGS\pinterest.png"
LinkFile6 = "http://www.pinterest.com/seredmonton/boards/"
PicFile7 = "\\sersbs11\Common Shared Files\EMAILSIGS\linkedin.png"
LinkFile7 = "http://www.linkedin.com/company/special-event-rentals"
PicFile99 = "\\sersbs11\Common Shared Files\EMAILSIGS\seropenhouse.jpg"
Set objShape7 = objSelection.InlineShapes.AddPicture(PicFile5, True)
objDoc.Hyperlinks.Add objShape7.Range, LinkFile5
Set objShape1 = objSelection.InlineShapes.AddPicture(PicFile1, True)
objDoc.Hyperlinks.Add objShape1.Range, LinkFile1
Set objShape2 = objSelection.InlineShapes.AddPicture(PicFile2, True)
objDoc.Hyperlinks.Add objShape2.Range, LinkFile2 & Chr(11)
Set objShape3 = objSelection.InlineShapes.AddPicture(PicFile3, True)
objDoc.Hyperlinks.Add objShape3.Range, LinkFile3 & Chr(11)
Set objShape4 = objSelection.InlineShapes.AddPicture(PicFile4, True)
objDoc.Hyperlinks.Add objShape4.Range, LinkFile4 & Chr(11)
Set objShape5 = objSelection.InlineShapes.AddPicture(PicFile6, True)
objDoc.Hyperlinks.Add objShape5.Range, LinkFile6 & Chr(11)
Set objShape6 = objSelection.InlineShapes.AddPicture(PicFile7, True)
objDoc.Hyperlinks.Add objShape6.Range, LinkFile7 & Chr(11)
Set objCell = objTable.Cell(4, 1)
Set objCellRange = objCell.Range
objCell.Select
objSelection.InlineShapes.AddPicture(PicFile99)
Set objSelection = objDoc.Range()
objSignatureEntries.Add strSignatureName, objSelection
objSignatureObject.NewMessageSignature = strSignatureName
objSignatureObject.ReplyMessageSignature = strSignatureName
objDoc.Saved = True
objWord.Quit
|
|
|
|
|
Sounds like maybe a network problem. Check that the workstation can still access the remote files. Other than that you will need to do some detailed diagnostic investigation.
|
|
|
|
|
I have the same issue. I tried using a local file instead and get the same error.
In the event log it is showing that Word crashes
|
|
|
|
|
No idea why you are posting this message to me, on a thread that is more than two years old.
|
|
|
|
|
|
I wasn't; I just wondered what your message was supposed to be about, and why you posted it to me after such a long period of time.
|
|
|
|
|
I'm new to working with XML in VB.NET and would like a little help after tearing my hair out for a couple of days.
I have an XML file with the following structure:
-<conceptGrp>
-<descripGrp>
<descrip type="subjectField">6411, 6821</descrip>
</descripGrp>
-<languageGrp>
<language lang="DE" type="German"/>
-<termGrp>
<term>Scheren</term>
-<descripGrp>
<descrip type="termType">fullForm</descrip>
</descripGrp>
-<descripGrp>
<descrip type="reliabilityCode">3</descrip>
</descripGrp>
</termGrp>
</languageGrp>
-<languageGrp>
<language lang="EN" type="English"/>
-<termGrp>
<term>scissors</term>
-<descripGrp>
<descrip type="termType">fullForm</descrip>
</descripGrp>
-<descripGrp>
<descrip type="reliabilityCode">3</descrip>
</descripGrp>
</termGrp>
</languageGrp>
</conceptGrp>
First I need to cycle through all the elements in the file (>550000) and for each element extract the text
"6411, 6821" from
<descrip type="subjectField">6411, 6821</descrip>
and
"3" from
<descrip type="reliabilityCode">3</descrip>
The <descrpGrp> appears just once for each element.
The <languageGrp> appears at least twice but up to 20 times.
The <termGrp> appears mostly once but up to 10 times for each <languageGrp>.
The <descrpGrp> appears twice for each <termGrp>.
The <descrip type="reliabilityCode" ...> appears just once for each term.
Using the extracted strings I look them up and need to replace them with text in the element.
This is my code so far for getting the <descrip type="reliabilityCode">3</descrip>:
For Each conceptGrp In xDoc.Elements("conceptGrp")
For Each languageGrp In conceptGrp.Elements("languageGrp")
For Each termGrp In languageGrp.Elements("termGrp")
Dim code = termGrp.Element("reliabilityCode")
For Each descripGP In termGrp.Elements("descripGrp")
For Each descrip In descripGP.Elements("descrip")
Dim reliability As String = xDoc.selectSingleNode("/Categories/category[@descrip='reliability code']").InnerText
Next descrip
Next descripGP
Next termGrp
Next languageGrp
Next conceptGrp
When I look in the locals window I can see "descrip" and for the first node the property "next node" with the value I want but I just can't grab it.
How can I easily get the value and then replace it in the element with my looked up text?
Thanks
Ben
modified 17-May-17 20:17pm.
|
|
|
|
|
If Only You Knew The Power Of The Dark Side XPath!
|
|
|
|
|
Not at all a helpful answer, but thanks for taking the time to write something 
|
|
|
|
|
The helpful bit was the suggestion to use XPath. If you look at the structure of the XML there is only ever one descrip element in each descripGrp, so maybe you are accessing it in the wrong way.
|
|
|
|
|
That is correct.
There is in each element just one <descrip type="subjectField">6411, 6821. There are over 700 possible values for subjectField and there can be multiple values each separated by a comma. Her we have two values "6411" and "6821".
In each element there are a minimum of two languageGrp and a maximum of thirty. It varies throughout the file.
In each languageGrp there is at least one termGrp up to a maximum of 10.
In each termGrp there is just one <descrip type="reliabilityCode">3. There are up to five possible values of this code, here it is "3".
I've never used XPath and have not much useful reference material at the moment. It's all new to me, I'm an old VB/C# horse.
|
|
|
|
|
Ben Senior wrote: not much useful reference material
Seriously? There is no end of it, from MSDN documentation to articles in both VB and C#.
|
|
|
|
|
I'd like to help you, but I'm a bit unclear as to what you need to do.
Do you want to take,
<descrip type="reliabilityCode">3</descrip>
and change it to
<descrip type="reliabilityCode">reliabilityCode</descrip>
and do the same for
<descrip type="subjectField">6411, 6821</descrip>
I think this can be done cleaner with xPath statements, rather then lots of looping.
If my understanding is correct, then I will help with the xPath statements.
![Java | [Coffee]](https://codeproject.global.ssl.fastly.net/script/Forums/Images/coffee.gif)
|
|
|
|
|
Hi David,
No. What I want to do is take:
<descrip type="reliabilityCode">3
and replace it with:
<descrip type="reliabilityCode">Very reliable
The "3" can vary and when I get this numerical code I have a function from where I can retrieve its text equivalent. I then need to insert the text equivalent back into the XML file. There are five of these numeric codes.
I'm new to XML and have never used XPath before so I'm struggling at the moment. I've been researching XPath and LINQ and just can't seem to get the hang of them.
I have been using the looping as that's what I'm used to doing in VB and C#.
The last thing that I will need to do is go through each element and depending upon the value of the subject field write the whole element to a new file for that subject. But first thing first and replace the numeric codes with text.
The subjectField is very similar other than there are over 700 subjects. I already have a function which converts the numeric subject field codes into text, and as above I need to insert the text back into the XML file.
|
|
|
|
|
See if this code helps. I realize that it doesn't do exactly what you want, but it shows how xPath works.
Dim xDoc As New XmlDocument
Dim xNodeList As XmlNodeList
Dim xNode As XmlNode
xDoc.Load("C:\Temp\test.xml")
xNodeList = xDoc.SelectNodes("/conceptGrp/descripGrp/descrip[@type='subjectField']")
For Each xNode In xNodeList
xNode.InnerText = xNode.Attributes("type").Value
Debug.Print(xNode.InnerText)
Next
xDoc.Save("C:\Temp\test_1.xml")
|
|
|
|
|
I had to add the root to the code ie. "/mtf/conceptGrp/descripGrp/descrip[@type='subjectField']" and a variable codeID to hold the value from
codeID = xNode.InnerText instead of your
xNode.InnerText
I replaced the codeID with codeText (the corresponding text from my function) and reinserted it into the xml file.
I need to test out the subjectField, but I don't anticipate any difficulties because it basically the same as for reliabilityCode.
Works a treat. Thanks for your help. Now I'm getting there with XPath 
|
|
|
|
|
You can get and set the value using LINQ to XML and XML axis properties.
Dim conceptor = XDocument.Load("C:\file.xml")
Dim subjectField = conceptor...<descrip>.Where(Function(d) d.@type = "subjectField").Value
conceptor...<descrip>.Where(Function(d) d.@type = "subjectField").Value = "1234"
conceptor.Save("C:\file.xml")
The descendant axis property, ...<>, gets all descendants that have the name specified within the angle brackets. The attribute axis property, .@, returns a reference to the value of the specified attribute. The Value axis property returns a reference to the value of the first element in a collection of elements.
"As beings of finite lifespan, our contributions to the sum of human knowledge is one of the greatest endeavors we can undertake and one of the defining characteristics of humanity itself"
|
|
|
|
|
Thanks for that Meschack,
As I said above I have solved that problem, with the help of people here, and now moved on to the next stage in the project, which is moving along quite well.
I have noted your suggestions along with the others, for reference and future use.
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
