Run-Time Error '2046': The Command or action TransferText isn't available now.

[Hashiru]

Hi all my code hung up at the highlighted line (last line of code).

Please can anyone advice of what to do to resolve this problem? Thanks in advance.

Sub CreateNewDB_DAO()
    Dim db As DAO.Database
    Dim dbName As String
    Dim tblNew As DAO.TableDef
    Dim fld As DAO.Field
    Dim prp As DAO.Property
    
    MyName = InputBox("Enter your chosen name for the database")
    
    dbName = "C:\Users\C033732\Desktop\Dennis Weekly Report\" & MyName & ".accdb"
    'dbName = "C:\Users\hashi\Desktop\PT\" & MyName & ".accdb"
    
    'On Error GoTo ErrorHandler
    
    Set db = CreateDatabase(dbName, dbLangGeneral)
    
    Set tblNew = db.CreateTableDef("CurrentData")
    
    'Create Fields
    'Dim NewSht As Worksheet
    'Set NewSht = ThisWorkbook.Worksheets("Fields")
    'LastColumn = NewSht.Cells(1, Columns.Count).End(xlToLeft).Column
    
    'For i = 1 To LastColumn
        'Set fld = tblNew.CreateField(NewSht.Cells(1, i))
        'tblNew.Fields.Append fld
    'Next i
'db.TableDefs.Append tblNew
'Create Fields
Set fld = tblNew.CreateField("FAIN", dbText)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("Fund", dbText)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("Scope", dbText)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("ALI", dbText)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("Project", dbText)
tblNew.Fields.Append fld


Set fld = tblNew.CreateField("BRD Amount", dbCurrency)
tblNew.Fields.Append fld

Set fld = tblNew.CreateField("RMB Amount", dbCurrency)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("UTL Amount", dbCurrency)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("Type", dbText)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("Package", dbText)
tblNew.Fields.Append fld
db.TableDefs.Append tblNew
    'import CSV into temp table
    'Browse for the Datasource and set the title of the dialog box.
    Dim MyFile As FileDialog
    Set MyFile = Application.FileDialog(msoFileDialogFilePicker)
    With MyFile
        
    .Title = "Browse for the Text File (file extension is .txt)"
        If .Show = True Then
         ' Assign the file to a variable Reportbk.
            txtfilepath = MyFile.SelectedItems.Item(1)
            Else
               MsgBox "You clicked Canncel in the file dialog box.", , "Canceling the import process"
                Exit Sub
        End If
    End With
    DoCmd.TransferText TransferType:=acImportDelim, TableName:=tblNew.Name, Filename:=txtfilepath, HasFieldNames:=True

End Sub

 

[Hashiru]

Hi Norie,

I placed the code in Access and the data imported with the exception of Fields with spaces in the field name.

 DoCmd.RunSQL "SELECT FAIN,  ALI, Project, Activity, "Resource ID", "System Source" ,Voucher, Vendor, "Vendor Name", "RMB Amount", "UTL Amount", Type, Package INTO CurrentData FROM [Text;DATABASE=C:\Users\hashiru\Desktop\Report Templates;HDR=Yes].CurrentWeek.csv"

How do I correct it?

 

[Norie]

Try putting square brackets round any field name with a space.

DoCmd.RunSQL "SELECT FAIN,  ALI, Project, Activity, [Resource ID], [System Source] ,Voucher, Vendor, [Vendor Name], [RMB Amount], [UTL Amount], Type, Package INTO CurrentData FROM [Text;DATABASE=C:\Users\hashiru\Desktop\Report Templates;HDR=Yes].CurrentWeek.csv

 

[Hashiru]

That's a good question. I know how to create excel instance in access but not the other way round.

Also, I have tried running the code in Access and it worked with just one line of code but did not import fields with spaces in the field names (see below for example). Please help me with the code to instantiate access from excel.

    DoCmd.RunSQL "SELECT FAIN, Scope, ALI, Project,  Resource ID, System Source, Voucher, Vendor, Vendor Name ,RMB Amount, UTL Amount,Type INTO CurrentData FROM [Text;DATABASE=C:\Users\hashi\Desktop\CSVFile;HDR=Yes].MSQueryCurrent.csv"

Thanks for all the suggestion.

 

[Hashiru]

Sorry did not see the above suggestion. I will try that [] on the field names with spaces.

Thanks

 

[Hashiru]

Thanks all I was able to import the files into Access with code in Access module. The big task now is to create a query to have the difference greater than zero between two identical fields (one in each table). Another identitcal fields Will the primary/foreign keys between which is the point of reference in the analysis

 

[Hashiru]

Thanks for help thus so far.
I know right, I missed that part and wondering if you can help with instantiating Access from within Excel Code module.

Based on that for now I will like to modify the approach by putting the code in Access code module and reduce to work load for now that I need some working stuff.

Requirement:
(i) I will like to replace the Path and the file name with variables because many staff will have to run this report and hard-coding will mean I have to do it for every staff or if they change file or folder name and path.

Here is what I currently have in Access code Module:

Sub ImportCVSFile()
    Dim selectedFolder
    
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            selectedFolder = .SelectedItems(1)
        End With
    
        'print to screen the address of folder selected
        'MsgBox (selectedFolder)
DeleteTable
DoCmd.SetWarnings False
    DoCmd.RunSQL "SELECT * INTO CurrentData FROM [Text;DATABASE=selectedFolder;HDR=Yes].DennisReport.csv"
    'DoCmd.RunSQL "SELECT * INTO CurrentData FROM [Text;DATABASE=C:\Users\Hashiru\Desktop\Report Templates;HDR=Yes].DennisReport.csv"
DoCmd.SetWarnings True
End Sub
Sub DeleteTable()
Dim conn As ADODB.Connection
Dim strTable As String
    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection
    strTable = "CurrentData"
    conn.Execute "DROP TABLE " & strTable
    Application.RefreshDatabaseWindow
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    If Err.Number = -2147217900 Then
        DoCmd.Close acTable, strTable, acSavePrompt
    Resume 0
    Else
        MsgBox Err.Number & ":" & Err.Description
        Resume ExitHere
    End If
End Sub

<strike></strike>

 

[xenou]

You only need to concatenate the string with the values you want to use.
For example,

dim a as String
dim b as String
a = "string"
b = " or nothing!"
debug.print a & b '//Expected Result: String or nothing!

However, you should test for cases such as user hits cancel or close the dialog without picking any file - basically meaning, check all your possible return values from the folder picker or file picker and handle them appropriately. Often file/folder pickers return and empty string, but I have seen them return values such as "False". Also they may return a values such as -1 if a multi-select option is available and nothing is selected. Also as always with saving files, be sure you think about whether the file might already exist and what you want to do if that is the case (abort, overwrite, or append).

I don't like to give advice on user names because there are lots of ways to that with various pros and cons. But I generally use the environ function:
example:

dim s as String
s = environ("username")
debug.print s

a list of possible items that you can lookup with environ() is here:
http://www.utteraccess.com/forum/Environ-Function-List-t693880.html

 

[Hashiru]

Thanks Xenou, for the insight in line with the above advice I have adjusted the code but got Run-time Error '3001' Invalid argument. Research on the error but I cannot determine what is invalid. See code below:

Sub ImportCSVFile()
DeleteTable
Dim MyFile As FileDialog
Set MyFile = Application.FileDialog(msoFileDialogFilePicker)
  'Browse for the Datasource and set the title of the dialog box.
    With MyFile
        
    .Title = "Browse for the relevant Report "
        If .Show = True Then
         ' Assign the file to a variable Reportbk.
            accessfilepath = MyFile.SelectedItems.Item(1)
            Else
               MsgBox "You clicked Canncel in the file dialog box.", , "Canceling the data extraction process"
                Exit Sub
        End If
    End With
Dim DB As String
StrFileName = Mid(accessfilepath, InStrRev(accessfilepath, "\", -1) + 1, Len(accessfilepath) - InStrRev(accessfilepath, "\", -1))
StrPath = Left(accessfilepath, InStrRev(accessfilepath, "\", -1) - 1)
DoCmd.SetWarnings False
    DoCmd.RunSQL "SELECT * INTO CurrentData FROM [Text;" & StrPath & ";HDR=Yes]." & StrFileName
    'DoCmd.RunSQL "SELECT * INTO CurrentData FROM [Text;DATABASE=C:\Users\C033732\Desktop\WMATA Report Templates;HDR=Yes].DennisReport.csv"
DoCmd.SetWarnings True
End Sub

<strike></strike>

 

[xenou]

What line does the error occur on?

Also it looks like you left out the "DATABASE=" stuff.

I would suggest you debug.print or message box your string after the concatenation. That is how you can verify it is correct.

for example:

dim myCommand as String
myCommand = "SELECT * INTO CurrentData FROM [Text;" & StrPath & ";HDR=Yes]." & StrFileName
[B][COLOR="#FF0000"]debug.print myCommand[/COLOR][/B]

 

[Hashiru]

Thanks, I cut that "DATABASE=" stuff, but Iran into another problem (Deleting a Table) Since that is different I have already posted it anew thread.

Here: https://www.mrexcel.com/forum/microsoft-access/1067695-unable-delete-table-endless-loop.html