Im trying to write to a text file using VBA. Here is my code:
DoCmd.SetWarnings False
'Delete all data from the source table
DoCmd.RunSQL "DELETE * FROM tblSource;"
'Run query to fill it
DoCmd.OpenQuery "qryFilltblSource"
' Declare a FileSystemObject.
Dim fso As FileSystemObject
' Create a FileSystemObject.
Set fso = New FileSystemObject
' Declare a TextStream.
Dim stream As TextStream
' Create a TextStream. The true part overwrites a text file it it already exists
Set stream = fso.CreateTextFile("C:\Target Folder", True)
Set rst = CurrentDb.OpenRecordset("tblSource")
Dim i As Integer
i = 1
Do Until rst.EOF = True
stream.WriteLine (rst!i)
i = i + 1
rst.MoveNext
Loop
stream.Close
DoCmd.SetWarnings True
The first error, I'm assuming I'm probably going to get another one, is "Permission Denied." I can't understand this one as I'm an Admin on this machine. I looked at the target folder and I have fill permissions to do what I want to it - but when I view its properties the box for "Read Only" is highlighted - why is this?
Thanks
You will not be permitted to write to C root, so C:\Target Folder\Atextfile.txt
Consider using TransferText:
DoCmd.TransferText acExportDelim, , tblSource, "c:\docs\output.txt", True
Note that you cannot say:
Dim i As Integer
i = 1
Do Until rst.EOF = True
stream.WriteLine (rst!i) <-- i is a record, not a field
i = i + 1
rst.MoveNext
Loop
You need
Do Until rst.EOF
For i=0 to rst.Fields.Count-1
stream.WriteLine rst(i) ''or rst(i) & "" to avoid problems with Null
Next
rst.MoveNext
Loop
Related
I am recently working with some data analysis in my project. In my case I need to run a VBA that can automatically read the data from a list of closed excel workbook named from 1-80 by ascending order, in which the data i would like to read is store at cell F7 .
That's how the data set looks like
I try to study the threads on internet and i come up with the following "function". It actually works but it doesn't loop according to ascending order.(1,2,3.....9,10,11.......80) Is the excel treat my file name as String instead of numeric value? If yes, how to troubleshoot sorting problems?
Private Sub test()
Dim fso As Object, FolDir As Object, FileNm As Object, Cnt As Integer
On Error GoTo erfix
Set fso = CreateObject("scripting.filesystemobject")
Set FolDir = fso.GetFolder("D:\Data\FYP")
Application.ScreenUpdating = False
For Each FileNm In FolDir.Files
If FileNm.Name Like "*" & ".xls" & "*" Then
Application.DisplayAlerts = False
UpdateLinks = True
Workbooks.Open Filename:=FileNm
Application.DisplayAlerts = True
Cnt = Cnt + 1
ThisWorkbook.Sheets("Sheet1").Range("A" & Cnt).Value = _
Workbooks(FileNm.Name).Sheets("Sheet1").Range("F" & 7)
Workbooks(FileNm.Name).Close SaveChanges:=False
End If
Next FileNm
Application.ScreenUpdating = True
Set FolDir = Nothing
Set fso = Nothing
Exit Sub
erfix:
On Error GoTo 0
MsgBox "Error"
Application.ScreenUpdating = True
Set FolDir = Nothing
Set fso = Nothing
End Sub
Thank you
I took the code from here and adjusted it
Option Explicit
Function kc_fsoFiles(theFolder, pattern) As Object
Dim rsFSO, objFSO, objFolder, File
Const adInteger = 3
Const adVarChar = 200
'create an ADODB.Recordset and call it rsFSO
Set rsFSO = CreateObject("ADODB.Recordset")
'Open the FSO object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'go get the folder to output it's contents
Set objFolder = objFSO.GetFolder(theFolder)
'create the various rows of the recordset
With rsFSO.Fields
.append "Name", adVarChar, 200
' Field for the "number" part of the file name
.append "DecName", adInteger
End With
rsFSO.Open
'Now let's find all the files in the folder
For Each File In objFolder.Files
'hide any file that begins with the character to exclude
If File.Name Like pattern Then
rsFSO.AddNew
rsFSO("Name") = File.Name
' if the basename is not an integer this will pobably crahs
rsFSO("DecName") = objFSO.getbasename(File.Name)
rsFSO.Update
End If
Next
'Now get rid of the objFSO since we're done with it.
Set objFSO = Nothing
'And finally, let's declare how we want the files
'sorted on the page. In this example, we are sorting
'by DecName
rsFSO.Sort = "DecName ASC "
'Now get out of the objFolder since we're done with it.
Set objFolder = Nothing
'now make sure we are at the beginning of the recordset
'not necessarily needed, but let's do it just to be sure.
rsFSO.MoveFirst
Set kc_fsoFiles = rsFSO
End Function
If you use this function you will get a list of filenames sorted to your needs
Sub TestIt()
'Now let's call the function and open the recordset
'the folder we will be displaying
Dim strFolder:
strFolder = "...your folder here .."
'the actual recordset we will be creating with the kc_fsoFiles function
Dim rsFSO 'now let's call the function and open the recordset
Set rsFSO = kc_fsoFiles(strFolder, "*xlsx*")
'now we'll create a loop and start displaying the folder
'contents with our recordset. Of course, this is just a
'simple example and not very well formatted, i.e., not in
'a table, but it gets the point across on how you can
'ouput the recordset
While Not rsFSO.EOF
Debug.Print rsFSO.Fields("Name").Value
rsFSO.MoveNext
Wend
'finally, close out the recordset
rsFSO.Close
Set rsFSO = Nothing
End Sub
I'm trying to create a table in Excel, which takes data from Access Query. I'm unable to find this query listed under Data->From Access. I'm using Data->From Other Sources -> From Data connection Wizard -> ODBC DSN. On final step it throws error [Microsoft][ODBC Microsoft Access Drive] too few parameters. expected 1.
I will not post full query at this moment, it is long
I will post subquery part (with some formatting) , that already throws this error. Can someone take a look and pinpoint where is the problem.
All queries I have work properly in Access. But I need the results export to Excel, as whole reporting VBA tool is there. (I know I can make SELECT INTO and create table, but it is not as elegant and simple to update) Thank you all for your time. Have a nice day
SELECT
Employees.PersNo,
Employees.Employee_name,
Employees.Reporting_Month,
Employees.Gender_Key,
Employees.Start_Date,
Employees.Business_Unit,
Employees.Position_ID,
Employees.Position,
Employees.Local_Band,
Employees.PS_Group,
Employees.Wage_Amount,
val(Employees.Bonus) AS [Bonus_%],
val([Employees].[Commissions_(%)]) AS [Commisions_%],
Employees.Wage_type, Employees.Wkhrs,
Q1.Business_Unit,
Q1.Position_ID,
Q1.Position,
Q1.Local_Band,
Q1.PS_Group,
Q1.Wage_Amount,
[Q1].[Bonus_%],
[Q1].[Commisions_%],
Employees.Wage_type,
Employees.Wkhrs,
Employees.Evid_Status
FROM Employees LEFT JOIN (SELECT
Dateadd("m",1,[Employees.Reporting_Month]) AS Reporting_Month,
Employees.PersNo,
Employees.Local_Band,
Employees.PS_Group,
Employees.Wage_Amount,
val(Employees.Bonus) AS [Bonus_%],
val([Employees].[Commissions_(%)]) AS [Commisions_%],
Employees.Wage_type, Employees.Wkhrs,
Employees.Business_Unit,
Employees.Position_ID,
Employees.Position,
Employees.Evid_Status
FROM Employees WHERE Employees.Evid_Status=1 ) AS Q1
ON (Employees.Reporting_Month = [Q1].[Reporting_Month]) AND (Employees.PersNo = [Q1].[PersNo])
WHERE Employees.Evid_Status=1;
Because Position is a reserved word in MS Accces, simply escape the word in both outer query and subquery with backticks or square brackets.
Interestingly, while the table alias qualifier works for reserved words inside the MSAccess.exe GUI program, external ODBC calls like from Excel may fail without escaping such reserved words:
SELECT
...
Employees.[Position],
...
SELECT
...
Employees.`Position`,
...
You can use Excel to query Access, like you see in the link below.
http://translate.google.pl/translate?js=n&prev=_t&hl=pl&ie=UTF-8&layout=2&eotf=1&sl=pl&tl=en&u=http%3A%2F%2Fafin.net%2FKsiazkaSQLwExcelu%2FGraficznyEdytorZapytanSqlNaPrzykladzieMsQuery.htm
Also, consider using a parameter query to do the export from Access to Excel.
Dim dbs As DAO.Database
Dim qdfTemp As DAO.QueryDef
Dim strSQL As String, strQDF As String
Set dbs = CurrentDb
' Replace NameOfTableOrQuery with the real name of the table or query,
' replace NameOfForm with the real name of the form, and replace
' ADateControlOnForm and AnotherDateControlOnForm with the real names
' of the controls on that form
strSQL = "SELECT NameOfTableOrQuery.* FROM NameOfTableOrQuery " & _
"WHERE NameOfTableOrQuery.FieldName >= " & _
Format(Forms!NameOfForm!ADateControlOnForm.Value,"\#mm\/dd\/yyyy\#") & _
" And NameOfTableOrQuery.FieldName <=" & _
Format(Forms!NameOfForm!AnotherDateControlOnForm.Value,"\#mm\/dd\/yyyy\#") & "';"
strQDF = "_TempQuery_"
Set qdfTemp = dbs.CreateQueryDef(strQDF, strSQL)
qdfTemp.Close
Set qdfTemp = Nothing
' Replace C:\MyFolderName\MyFileName.xls with the real path and filename for the
' EXCEL file that is to contain the exported data
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strQDF,"C:\MyFolderName\MyFileName.xls"
dbs.QueryDefs.Delete strQDF
dbs.Close
Set dbs = Nothing
Or...write data from a record set in Access to Excel.
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
blnEXCEL = False
' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True
' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file into which you will write the data
Set xlw = xlx.Workbooks.Open("C:\Filename.xls")
' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
' (note that the worksheet must already be in the EXCEL file)
Set xls = xlw.Worksheets("WorksheetName")
' Replace A1 with the cell reference into which the first data value
' is to be written
Set xlc = xls.Range("A1") ' this is the first cell into which data go
Set dbs = CurrentDb()
' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbReadOnly)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1,0)
End If
' write data to worksheet
Do While rst.EOF = False
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1,0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close True ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
Or, simply import the data from Access to Excel.
Sub ADOImportFromAccessTable(DBFullName As String, _
TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
"TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
' all records
'.Open "SELECT * FROM " & TableName & _
" WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText
' filter records
RS2WS rs, TargetRange ' write data from the recordset to the worksheet
' ' optional approach for Excel 2000 or later (RS2WS is not necessary)
' For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
' Next
' TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Having the same error - linking Excel and Access.
After changing double quotes to single quotes the error "too few parameters. expected 1" was resolved. The sample of correct code.
AND all_clean.lastapp='Dial'
I have some working code that loops through a folder full of Excel files, and imports a table from each into the an Access table. All I'm trying to do is add a field at the end of the table called FileName that has the name of the source Excel file.
I've done some Googling and found this solution:
How to add file name when importing multiple Excel files to one Access table
I've tried to incorporate the solution into my code, but when I reach the execute statement, I get:
Run-time error '3061' Too few parameters. Expected 2.
I think the problem is just with the strSQL statement and/or the way I'm executing it at the end.
Public Sub Command0_Click()
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
Dim qdf As DAO.QueryDef
Set db = CurrentDb()
'make the UPDATE a parameter query ...
strSQL = "UPDATE Test SET FileName=[pFileName] WHERE FileName Is Null OR
FileName='';"
Set qdf = db.CreateQueryDef(vbNullString, strSQL)
path = "C:\Users\u005984\Desktop\Test\"
'Loop through the folder & build file list
strFile = Dir(path & "*.xlsx")
While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If
'cycle through the list of files
For intFile = 1 To UBound(strFileList)
filename = path & strFileList(intFile)
DoCmd.TransferSpreadsheet acImport, 9, "Test", filename, True
'Add filename field
qdf.Parameters("pFileName").Value = strFileList(intFile)
qdf.Execute dbFailOnError
Next intFile
End Sub
I'm new to Access VBA and SQL, and can't figure out why its expecting 2 parameters. Grateful for any help.
Adjust your SQL query, your's doesn't contain the parameter.
strSQL = "PARAMETERS pfilename Text ( 255 ); UPDATE Test SET FileName=[pFileName] WHERE FileName Is Null OR FileName='';"
Adding a FileName field is markedly different than updating its value. Hence, you need two SQL action queries: ALTER and UPDATE statements.
Specifically, the query requires two components that are unknown by the engine: FileName column and [pFileName] parameter value. Most likely, your Excel worksheets do not have a FileName column being imported into Test table.
Consider the following setup employing an ALTER statement within loop (only on very first iteration since all worksheets append to same table):
'Add filename field
For intFile = 1 To UBound(strFileList)
filename = path & strFileList(intFile)
DoCmd.TransferSpreadsheet acImport, 9, "Test", filename, True
If intFile = 1 then
' ALTER TABLE
CurrentDb.Execute "ALTER TABLE [Test] ADD COLUMN [FileName] TEXT(255)", dbFailOnError
End If
' UPDATE TABLE (PASSING PARAM VALUE)
qdf.Parameters("pFileName").Value = strFileList(intFile)
qdf.Execute dbFailOnError
Next intFile
I have a slew of files that I need exported into Access. I'm using the following code to import all .txt files within the folder in a table in Access. I needed to use a custom Import Spec due to the presence of colons in some of the files which Access kept trying to treat as time.
Option Compare Database
Private Sub Command0_Click()
Dim fso As Object
Dim fld As Object
Dim fil As Object
Dim FldPath As String
Dim MyResult As String
Const DestTable As String = "Splits"
FldPath = "C:\Users\User\Desktop\yahoo\yahoo_splits"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FldPath)
With DoCmd
.SetWarnings False
For Each fil In fld.Files
If UCase(Right(fil.Name, 3)) = "txt" Then
MsgBox (fil.Path)
DoCmd.TransferText acImportDelim, "SPTImport", "Splits", fil.Path, False
CurrentDb.Execute ("Update Splits Set MyNewField = '" & fil.Name & "' where MyNewField is null")
End If
Next
.SetWarnings True
End With
Set fil = Nothing
Set fld = Nothing
Set fso = Nothing
MsgBox "done"
End Sub
When I try to import the file, I get the error:
The Microsoft Access database engine could not find the object 'Fox.spt.txt'. Make sure the object exists and that you spell its name and the path name correctly.
What is odd is that I even added the message box prompt just before the import step so that I could verify that it is calling the right path before it gets to the code that errors out.
Any help would be greatly appreciated!
I am new to coding VBA. Was wondering if you all could help me? I have a CSV file which is structured as the following:
- First 22 rows cover the specfic header data(this all loads in one column in excel)
- column headers for table are in Row 23
- the data is actually located from row 24 onward.
What the code needs to do is insert this data in new table with the right column titles. Also while inserting it needs to input the file name and header data in the first few columns of the table.
So far I have imported the entire CSV into an array I believe:
See what I have so far:
Sub readCSV()
Dim fs As Object
Dim fso As New FileSystemObject
Dim tsIn As Object
Dim sFileIn, filename As String
Dim aryFile, aryHeader, aryBody As Variant
sFileIn = "C:\doc\test.csv"
Set filename = fso.GetFileName(sFileIn)
Set fs = CreateObject("Scripting.FileSystemObject")
Set tsIn = fs.OpenTextFile(sFileIn, 1)
sTmp = tsIn.ReadAll
aryFile = Split(sTmp, vbCrLf)
For i = 1 To 22
aryHeader(1, i) = aryFile(i)
Next i
For i = 23 To UBound(aryFile)
aryBody(i) = Split(aryFile(i), ",")
DoCmd.RunSQL "INSERT INTO MAINS VALUES (filename,aryHeader(1),aryBody(i))"
Next i
End Sub
is this correct? Can anyone see of i am taking the right approach
UPDATE - recoded this a bit
Use DoCmd.TransferText instead of rolling out your own code:
http://msdn.microsoft.com/en-us/library/office/ff835958%28v=office.15%29.aspx
In your Import Specification, you can set the starting row.
See Skip first three lines of CSV file (using DoCmd?) in MS Access for more information!
Edit: The import specification can be changed to rename the fields etc. See http://www.access-programmers.com/creating-an-import-specification-in-access-2003.aspx (the Import wizard exists in Access 2007 as well) and the Advanced dialog specifically.
I was a bit irked by the use of multiple arrays in your code (which is super confusing, to me, anyway, because you are looking at counters everywhere) so I thought I would post an alternative for you. If you can do it your way, more power to you, but if you run into problems, you can try this. Code below is much more verbose, but may save you time in the future if you hand it off or even have to come back to it yourself and have no idea what is going on (lol):
Sub ReadCSV()
On Error GoTo ErrorHandler
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim fso As Scripting.FileSystemObject
Dim tst As Scripting.TextStream
Dim strFileName As String
Dim intCurrentLine As Integer
Dim strCurrentLine As String
Dim intHeaderRows As Integer
Dim strHeader As String
Dim strHeaderDelimInField As String
'Consider these your 'constants', so you don't come back to this code in a month
'and wonder what the random numbers mean.
intHeaderRows = 22 'Number of header rows in CSV.
strHeaderDelimInField = "~" 'The character(s) you want to separate each
'header line, in field.
strFileName = "C:\IrregularCSV.csv"
intCurrentLine = 1 'Keep track of which line in the file we are currently on.
'Next two lines get a reference to your table; will add data via DAO and not SQL,
'to avoid messy dynamic SQL.
Set db = CurrentDb()
Set rst = db.OpenRecordset("Mains", dbOpenDynaset)
Set fso = New Scripting.FileSystemObject
Set tst = fso.OpenTextFile(strFileName, ForReading)
'Instead of storing data in arrays, let's go through the file line by line
'and do the work we need to do.
With tst
Do Until .AtEndOfStream
strCurrentLine = .ReadLine
If intCurrentLine <= intHeaderRows Then
strHeader = strHeader & strHeaderDelimInField & strCurrentLine
Else
'Add the records via DAO here.
rst.AddNew
'In DAO, rst.Fields("FieldName") are the columns in your table.
rst.Fields("FileName") = strFileName
'Remove leading delimiter with Right.
rst.Fields("HeaderInfo") = Right(strHeader, Len(strHeader) - 1)
'Note that Split always returns a zero-based array
'and is unaffected by the Option Base statement.
'The way below is less efficient than storing
'the return of Split, but also less confusing, imo.
rst.Fields("Field1") = Split(strCurrentLine, ",")(0)
rst.Fields("Field2") = Split(strCurrentLine, ",")(1)
rst.Fields("Field3") = Split(strCurrentLine, ",")(2)
rst.Update
End If
intCurrentLine = intCurrentLine + 1
Loop
End With
tst.Close
rst.Close
ExitMe:
Set tst = Nothing
Set fso = Nothing
Set rst = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ": " & Err.Description
GoTo ExitMe
End Sub
To be honest, I think there are a lot of gotchas to the way you are going about it. Not saying it won't work, because I think it can, but this method is more robust. An unexpected single quote won't ruin your work and using a data object to do the inserts is not prone (well, less, at least) to SQL injection issues. And I've done it with no persisted arrays. Anyway, some food for thought. Good luck.
this is what i ended up:
Sub ReadCSV2()
Dim fs As Object
Dim filename As String
Dim tsIn As Object
Dim sFileIn As String
Dim aryHeader, aryBody As Variant
Dim Text As String
Dim sqlcre As String
Dim sqlsta As String
sFileIn = "C:\test\test.csv"
filename = GetFilenameFromPath(sFileIn) 'function to get the file name
Set fs = CreateObject("Scripting.FileSystemObject")
Set tsIn = fs.OpenTextFile(sFileIn, 1)
For i = 1 To 23
Tmps = tsIn.ReadLine
Next i
aryHeader = Split(Tmps, ",")
On Error Resume Next
DoCmd.RunSQL "DROP TABLE tempdata"
On Error GoTo 0
sqlcre = "CREATE TABLE tempdata ([Filename] Text,"
For k = LBound(aryHeader) To UBound(aryHeader)
sqlcre = sqlcre & "[" & aryHeader(k) & " " & k + 1 & "] Text,"
Next k
k = k - 1
sqlcre = Left(sqlcre, Len(sqlcre) - 13) & ")"
'Debug.Print k
'Debug.Print sqlcre
DoCmd.RunSQL sqlcre
DoCmd.SetWarnings False
While Not tsIn.AtEndOfStream
Tmps = tsIn.ReadLine
aryBody = Split(Tmps, ",")
sqlsta = "INSERT INTO tempdata VALUES ('" & filename & "','"
For M = LBound(aryBody) To UBound(aryBody)
sqlsta = sqlsta & Replace(aryBody(M), "'", "`") & "', '"
Next M
M = M - 1
Debug.Print M
If M < k Then
Text = ""
For i = 1 To (k - M)
Text = Text & "', '"
Next i
sqlsta = sqlsta & Text
End If
sqlsta = Left(sqlsta, Len(sqlsta) - 7) & ")"
'Debug.Print sqlsta
'Debug.Print k
DoCmd.RunSQL sqlsta
Wend
DoCmd.SetWarnings True
End Sub