I'm trying to save a template on a specific place. For example, if a product have the GnrSerie = 1000, it should go to that folder, and then the if the Gnr = E2000, it should go to that folder and then name the file GnrSerie + "-" + Gnr.
I use the following code to save the file:
.SaveAs "CAN'T SHOW THIS\" & rst![GnrSerie] & "\" & rst![Gnr] & "\" & rst![GnrSerie] & "-" & rst![Gnr], wdFormatDocument
Further more, I am connected to the databases/tables where GnrSerie and Gnr is placed
Dim rst As DAO.Recordset
Dim sql As String
Dim db As Database
Set db = CurrentDb
sql = "SELECT * FROM Projektdata WHERE Sagsnr Like '*" & Forms!Sag_Form!SagNr & "*'"
Set rst = db.OpenRecordset(sql, dbOpenDynaset)
When I run it, it just pops up and ask me where I want to save the file.
You probably will have to specify the drive as well:
.SaveAs "D:\CAN'T SHOW THIS\" & rst![GnrSerie] & "\" & rst![Gnr] & "\" & rst![GnrSerie] & "-" & rst![Gnr], wdFormatDocument
Related
I have a database which stores customer job data. This data is also used to print certificates for the customer via export to an existing word document. The database is quite old and works fine on office 2003. Upon upgrading to latest office 365 I now have an issue whereby after I export the data to Word, I cannot close Word without Access also closing. I then have to re-open Access to continue using the database. Hoping somebody knows how to stop this happening.
The data is exported to Word at the click of a button in a form and the VBA code it runs is listed below. (I did not create the code or the database)
Thanks in advance
Private Sub btnPrintCert_Click()
On Error GoTo Err_btnPrintCert_Click
Dim strSQL As String
Dim RetVal As Double
Dim txtWordPath As String
Dim txtDocPath As String
Dim txtShellCommand As String
If Me.Dirty Then
RunCommand acCmdSaveRecord
End If
' delete temporary table
DoCmd.DeleteObject acTable, "tbltemp_cert"
' build sql string
strSQL = "SELECT qryjobs.postal, qryjobs.payload, qryjobs.JobNumberFull, qryjobs.job_said, qryjobs.job_entrydate, qryjobs.job_number, qryjobs.job_description, qryjobs.job_required_by, qryjobs.job_client_ordernumber, "
strSQL = strSQL & "qryjobs.job_complete_date, qryjobs.job_completed, qryjobs.cert_owner, qryjobs.cert_address, qryjobs.cert_vehicleyear, qryjobs.cert_vehiclemake, qryjobs.cert_vehiclemodel, qryjobs.cert_chassis, "
strSQL = strSQL & "qryjobs.cert_vin, qryjobs.cert_rego, qryjobs.cert_axles, qryjobs.cert_application, qryjobs.cert_hubo, qryjobs.cert_huboserial, qryjobs.cert_readingdate, qryjobs.cert_hubo_expiry_km, "
strSQL = strSQL & "qryjobs.cert_fleetnumber, qryjobs.cert_tare, qryjobs.cert_GVM, qryjobs.cert_GCM, qryjobs.cert_period, qryjobs.cert_expires, qryjobs.cert_MTM_braked, qryjobs.cert_MTM_unbraked, "
strSQL = strSQL & "qryjobs.cert_front_axlerating, qryjobs.cert_rear_axlerating, qryjobs.cert_axle_spacings, qryjobs.cert_VSR_class, qryjobs.company, qryjobs.addr1line1, qryjobs.addr1line2, qryjobs.addr1line3, "
strSQL = strSQL & "qryjobs.addr1line4, qryjobs.addr1city, qryjobs.addr1state, qryjobs.addr1postcode, qryjobs.addr2line1, qryjobs.addr2line2, qryjobs.addr2line3, qryjobs.addr2line4, qryjobs.addr2city, qryjobs.addr2state, "
strSQL = strSQL & "qryjobs.addr2postcode, qryjobs.phone1, qryjobs.phone2, qryjobs.fax, qryjobs.identifier, qryjobs.salutation, qryjobs.contactname, qryjobs.notes, qryjobs.company_type, qryjobs.job_type_desc, "
strSQL = strSQL & "qryjobs.job_type_code, qryjobs.job_type_LTSA_appr_code, qryjobs.job_type_designcode, qryjobs.job_type_cert_text, qryjobs.job_cert_word_doc, qryjobs.job_type2_desc, qryjobs.job_type2_code, "
strSQL = strSQL & "qryjobs.job_type2_title, qryjobs.VSR_class, qryjobs.VSR_class_description, qryjobs.axle_description, qryjobs.vehicle_make, qryjobs.application_description, qryjobs.expired_now, qryjobs.cert_vertical_rating, qryjobs.vert_rating, "
strSQL = strSQL & "qryjobs.qrywelders_all.Name, qryjobs.qrywelders_all.Employer, qryjobs.qrywelders_all.[4711No], qryjobs.qrywelders_all.Positions, qryjobs.qrywelders_all.Expires "
strSQL = strSQL & "INTO tbltemp_cert FROM qryjobs WHERE [qryjobs.job_said] =" & Me!job_said & ";"
' write current record info to temp table
DoCmd.RunSQL strSQL
' open & display selected word document according to job type
' the Shell function runs an executable program and returns a
' Variant (Double) representing the program's task ID if successful,
' otherwise it returns zero.
txtWordPath = "C:\Program Files\Microsoft Office\root\Office16\Winword.exe"
txtDocPath = Me![job_cert_word_doc]
txtShellCommand = Chr(34) & txtWordPath & Chr(34) & " " & Chr(34) & txtDocPath & Chr(34)
Debug.Print "shellcommand: " & txtShellCommand
RetVal = Shell(txtShellCommand, 1)
Exit_btnPrintCert_Click:
Exit Sub
Err_btnPrintCert_Click:
MsgBox Err.Description
Resume Exit_btnPrintCert_Click
End Sub
I have an Access database with a ton of tables, forms, and queries in it. With one of my forms I have an upload button that I would like to use for appending csv files to a specific table in the database.
I have an OnClick function for the button that I am getting hung up on..
Every time it get to the line
adoCSVConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strPathToTextfile & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
It says that: the provider cannot be found or it is not installed properly..
Does this have anything to do with the settings in the Data Source Admin settings? Am I missing a reference?
Here is all of the code if you are interested in seeing what all I have
Private Sub uploadBTN_Click()
'Dim adoCSVConnection, adoCSVRecordset, strPathToTextfile
'Dim strCSVFile, adoJetConnection, adoJetCommand, strDBPath
Dim adoCSVConnection As ADODB.Connection
Dim adoCSVRecordset As ADODB.Recordset
Dim adoJetConnection As ADODB.Connection
Dim adoJetCommand As ADODB.Command
Set adoCSVConnection = New ADODB.Connection
Const adCmdText = &H1
' Specify path to CSV file. ex: c:\Scripts\
strPathToTextfile = "C:\Desktop\"
' Specify CSV file name. ex: Users.csv
strCSVFile = "testfile2.csv"
' Specify Access database file. ex: c:\Scripts\MyData.mdb
strDBPath = "\\folder\NewMasterclient.mdb"
' Open connection to the CSV file.
Set adoCSVConnection = CreateObject("ADODB.Connection")
Set adoCSVRecordset = CreateObject("ADODB.Recordset")
' Open CSV file with header line.
adoCSVConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strPathToTextfile & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
adoCSVRecordset.Open "SELECT * FROM " & strCSVFile, adoCSVConnection
' Open connection to MS Access database.
Set adoJetConnection = CreateObject("ADODB.Connection")
adoJetConnection.ConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);" _
& "FIL=MS Access;DriverId=25;DBQ=" & strDBPath & ";"
adoJetConnection.Open
' ADO command object to insert rows into Access database.
Set adoJetCommand = New ADODB.Command
Set adoJetCommand.ActiveConnection = adoJetConnection
adoJetCommand.CommandType = adCmdText
' Read the CSV file.
Do Until adoCSVRecordset.EOF
' Insert a row into the Access database.
adoJetCommand.CommandText = "INSERT INTO testfile2" & "(a, b, c, d, clientid, reg) " & "VALUES (" _
& "'" & adoCSVRecordset.Fields("a").Value & "', " _
& "'" & adoCSVRecordset.Fields("b").Value & "', " _
& "'" & adoCSVRecordset.Fields("c").Value & "', " _
& "'" & adoCSVRecordset.Fields("d").Value & "', " _
& "'" & adoCSVRecordset.Fields("clientid").Value & "')" _
& "'" & adoCSVRecordset.Fields("reg").Value & "')"
adoJetCommand.Execute
adoCSVRecordset.MoveNext
Loop
' Clean up.
adoCSVRecordset.Close
adoCSVConnection.Close
adoJetConnection.Close
End Sub
I'm looking for help in being able to run a script against every PC listed in a csv using VBScript. Currently we are using a small script which we found on the "Hey, Scripting Guy blog" which gathers us the correct information regarding PC to Printer relationship but only on one manually specificed PC. This is a breakdown on what we're trying to achieve:
Take a list of PCs which are stored in a CSV.
Run the script listed below to query the values in the CSV and run the script against that value.
Once it has run the script against the values within the file, move on to the next PC in the CSV list.
strComputer = "PC-13699"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
For Each objPrinter in colPrinters
If objPrinter.Attributes And 64 Then
strPrinterType = "Local"
Else
strPrinterType = "Network"
End If
Wscript.Echo objPrinter.Name & " -- " & strPrinterType
Next
I haven't had much experience with VBS at all so I'm a complete novice with this language so please bear with me if I'm sounding stupid. Thanks for your help in advanced!
Assuming your CSV has a field named ComputerName for the computer names you could modify your script like this:
filename = "C:\path\to\your.csv"
Set csv = CreateObject("Scripting.FileSystemObject").GetFile(filename)
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & csv.ParentFolder.Path & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
rs.Open "SELECT * FROM [" & csv.Name & "]", conn
Do Until rs.EOF
strComputer = rs.Fields("ComputerName").Value
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
For Each objPrinter in colPrinters
If objPrinter.Attributes And 64 Then
strPrinterType = "Local"
Else
strPrinterType = "Network"
End If
Wscript.Echo objPrinter.Name & " -- " & strPrinterType
Next
rs.MoveNext
Loop
rs.Close
conn.Close
I'm trying to export the results of a dynamic SQL statement but keep getting the error 3027 "Cannot update. Database or object is read-only.". I'm using Access 2003. GetYearFromDirName(sFolder) is parsing out a year from a directory structure and using that as a calculated column in the SQL results.
Here is the code in question:
sSQL = "SELECT INDEXDB1.IFIELD1 AS TestArea, INDEXDB1.IFIELD2 AS TSID, INDEXDB1.IFIELD3 AS MapCoord, " _
& "INDEXDB1.IFIELD4 AS Community, INDEXDB1.IFIELD5 AS Address, INDEXDB1.IFIELD6 AS DocNum, " _
& "'" & GetYearFromDirName(sFolder) & "' AS Yr FROM INDEXDB1;"
'DoCmd.TransferSpreadsheet acExport, , sSQL, sFolder & "\" & BoxNum & ".csv"
'DoCmd.OutputTo acOutputQuery, "ExportRecs", acFormatXLS, sFolder & "\" & BoxNum & ".csv"
SaveToExcel sSQL, sFolder & "\" & BoxNum & ".csv"
Calls:
Public Sub SaveToExcel(strSQL As String, strFullFileName As String)
Dim strQry As String
Dim db As Database
Dim Qdf As QueryDef
On Error GoTo SaveToExcel_err
strQry = "TempQueryName"
Set db = CurrentDb
'Set Qdf = db.CreateQueryDef(strQry, strSQL)
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, strQry, strFullFileName, True
'DoCmd.DeleteObject acQuery, strQry
With db
' Create permanent QueryDef.
Set Qdf = .CreateQueryDef(strQry, strSQL)
' Open Recordset and print report.
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel3, strQry, strFullFileName, True
' Delete new QueryDef because this is a demonstration.
.QueryDefs.Delete Qdf.Name
.Close
End With
Exit Sub
SaveToExcel_err:
MsgBox Error & " " & Err & " in sub SaveToExcel. Close program and start over."
End Sub
Is there a better way to export dynamic SQL statement results? In the end, I need a CSV file.
You may open it in Excel, but CSV is a text format, so you need to use DoCmd.TransferText instead of DoCmd.TransferSpreadsheet. Manually go through the export once using the Export Data Wizard. As you do so, you'll wand to create and name a Export Specification. This will specify commas as the delimiter and double quotes as text delimiters. The name of the export spec you created is passed as the second argument to TransferText.
Finally the administrator configured the IIS for me the error message is listed below.
Set SQLStream = CreateObject("ADODB.Stream")
Set SQLConnection = CreateObject("ADODB.Connection")
Set SQLCommand = CreateObject("ADODB.Command")
Set SQLRecordSet = CreateObject("ADODB.RecordSet")
SQLConnection.Open "Provider=sqloledb;SERVER=SQLPROD;DATABASE=MyDataBase;UID=MyUsername;PWDMyPassword;"
'Response.Write("Connection Status: " & SQLConnection.State) & vbnewline
'Response.Write("Connection Provider: " & SQLConnection.Provider) & vbnewline
'Response.Write("Version: " & SQLConnection.Version) & vbnewline
SQLCommand.ActiveConnection = SQLConnection
SQLCommand.CommandText = "SELECT Seminars.Year, Seminars.SeminarID, Seminars.Theme, Seminar_Week.First, Seminar_Week.Last, Seminar_Week.WeekID, Seminar_Week.Date, Seminar_Week.Affiliation FROM Seminars CROSS JOIN Seminar_Week"
'Response.Write("SQL Command Passed in: " & SQLCommand.CommandText)
Set adoRec = SQLCommand.Execute()
file1 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & adoRec("Year") & "_" & adoRec("Last") & ".pdf"
file2 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & seminar_year & "_" & adoRec("Last") & "(handouts).pdf"
file3 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & seminar_year & "_" & adoRec("Last") & "_Flyer.pdf"
Set fso = CreateObject("scripting.filesystemobject")
Response.Write("<p style=" & "margin-left:10px;" & "><img src=" & "./img/right_arrowblue.png" & " alt=" & "Expand/Collapse" & " id=" & "arrow_" & adoRec("Week") & " /><strong>[" & adoRec("Date") & "]</strong> " & ""&aroRec("First") & adoRec("Last") & ", " & adoRec("Affiliation") & "</p>")
The very last line of code causes this error
ADODB.Recordset error '800a0cc1'
Item cannot be found in the collection corresponding to the requested name or ordinal.
FilePath, line 244
Line 244 is the very last line of code that should write Some information about each seminar on the webpage.
I'm pretty sure at this point I am pointing to an incorrect file path because I have an extra space somewhere in all the different string.
My question now is Would the ones in the very beginning, meaning the ones used in
"<p style=" & "margin-left:10px;" & "><img src=" & "./img/right_arrowblue.png"
be causing the trouble.
I'm also unfamiliar with using the "Expand/collapse" so if someone could tell me a little more about that. I am trying to fix someone elses code so I am a little behind the 8 ball.
One small step to a solution:
Your SQL
"SELECT * FROM Seminars WHERE [SeminarID] = 5 ORDER BY DESC"
is definitely wrong: ORDER BY needs (at least) a column name: ORDER BY [SeminarID] DESC.
If that does not solve all your problems, we'll have to think about a step by step approach.
If you get errors, tell us about them (number, description, line). That's what I meant, when I ask you to publish them. If you can't better info than "There was an error when processing the URL" from IIS, then you have to write some command line script to get the database related code absolutely right.
Start with experiments.vbs:
Dim sCS : sCS = !your connection string!
Dim oCN : Set oCN = CreateObject("ADODB.Connection")
oCN.Open sCS
WScript.Echo "CN open:", oCN.State
Dim sSQL : sSQL = !your SQL statement!
Dim oRS : Set oRS = oCN.Execute(sSQL)
WScript.Echo "RS EOF:", CStr(oRS.EOF)
WScript.Echo "Frs Col:", oRS.Fields(0).Name, oRS.Fields(0).Type
Dim i : i = 0
Do Until oRS.EOF
WScript.Echo i, oRS.Fields(0).Value
i = i + 1
oRS.MoveNext
Loop
oCN.Close
and run it in a command window (DOS box): cscript experiments.vbs. This should get you either some lines like:
CN open: 1
RS EOF: False
Frs Col: Id 3
0 ...
1 ...
2 ...
or a focused/publishable error message like:
... .vbs(2465, 14) Microsoft OLE DB Provider for SQL Server: Falsche Syntax in der Nä
he des 'DESC'-Schlüsselworts.
(bad syntax near DESC), which got when I tried the statement
"SELECT * FROM Alpha ORDER BY DESC"
RS.MoveNext
Put the above code on the line before the Loop keyword to avoid an infinite loop.
Are you missing the loop keyword at the end of your loop block?
Check the syntax here: http://msdn.microsoft.com/en-us/library/eked04a7.aspx