Сообщения

С одинарными кавычками тоже пробовал. В текстовом поле текст появляется ограниченный одинарными кавычками - та же беда.
Нашел более эффективное решение. Для начала я создал локальную базу данных MySQL и сконвертил таблицу Access туда. С помощью менеджера баз данных HeidiSQL подключился к локальной базе и сохранил таблицу в скрипт-файл .sql
Файл .sql открывается обычным блокнотом, там оказались стандартные команды в стиле

Код (sql) Выделить Развернуть


/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
/*!40101 SET NAMES utf8 */;
/*!50503 SET NAMES utf8mb4 */;
/*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;
/*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
DELETE FROM AutocatPrice;
/*!40000 ALTER TABLE `AutocatPrice` DISABLE KEYS */;
INSERT INTO AutocatPrice (`ID`, `Payment`, `Analyse_Date`, `Brand`, `Model`, `Engine_Type`, `Engine_Size`, `Engine_Name`, `Year_First`, `Year_Last`, `Serial`, `Mass`, `Cat_Type`, `Pt`, `Pd`, `Rh`, `PricePerKg`, `Total_Price`, `Company`, `URL`, `Method`, `Notes`) VALUES
(1, 0, '2018-09-05', 53, NULL, NULL, NULL, NULL, NULL, NULL, 'KBA17001 / RFK-TT-20 / A', '0.70', 4, NULL, NULL, NULL, '67', '47', 1, NULL, 5, NULL),
(2, 0, '2018-10-03', 53, NULL, NULL, NULL, NULL, NULL, NULL, 'KBA17012', '1.50', 4, NULL, NULL, NULL, '67', '100', 1, NULL, 5, NULL)

HeidiSQL позволяет выполнять .sql скрипт для подключенной базы данных. Если подключиться к MySQL на удаленном сервере, то в отличие от ADODB, который выполняет последовательное обновление записей минут 30, через скрипт база обновляется за секунды.
Написать макрос, создающий подобный файл .sql по подсмотренному шаблону - это уже дело техники.
Апострофы  внутрь текста можно заносить в виде комбинаций \' или \" - синтаксис mysql
Были кое-какие сложности с форматом файла. FSO создает файлы в формате UTF-16, а база данных работает с UTF-8, из-за этого скрипт не распознавался. В гугле нашел примеры, в которых с помощью ADODB.Stream файлы можно конвертировать из одной кодировки в другую.
Осталось разобраться как запустить .sql файл без сторонних приложений.

Добрый день.
Написал скрипт для копирования данных из таблицы Access в таблицу MySQL. Структура таблиц и там и там одинакова. Сначала я всю таблицу Access переношу в массив типа Variant, из которого построчно беру данные и заполняю c помощью метода CopyRecord записи в MySQL. Сам CopyRecord просто создает Adodb.Command, которая вызывает хранимую процедуру SetRecord из MySQL и передаёт туда поля в виде параметров. В целом код рабочий и выглядит вот так

Код (vb) Выделить Развернуть


Public Sub CopyRecord(AccessArrayRecordNum As Long, AccessArrayTable As Variant)
'Заполнить строку в базе данных входящими параметрами
'AccessArrayTable - таблица данных из Access
'AccessArrayRecordNum - порядковый номер строки из базы данных Access, для которого выполнется запись в MySQL

Dim Command As Object

Set Command = CreateObject("ADODB.Command")
Set Command.ActiveConnection = Conn
Command.CommandType = 4 'Процедура
Command.NamedParameters = False 'Параметры поименованные
Command.commandtext = "SetRecord" 'Хранимая процедура на добавление или обновление записи в таблицу

Command.Parameters.Append Command.CreateParameter("varID", 19, 1) 'Создаем параметр adUnsignedInt(19), 1-входной
With Command.Parameters("varID")
   .Value = AccessArrayTable(0, AccessArrayRecordNum)
End With

Command.Parameters.Append Command.CreateParameter("varPayment", 17, 1) 'Создаем параметр adUnsignedTinyInt(17), 1-входной
With Command.Parameters("varPayment")
   .Value = CByte(AccessArrayTable(1, AccessArrayRecordNum))
End With

Command.Parameters.Append Command.CreateParameter("varAnalyse_Date", 133, 1) 'Создаем параметр adDBDate(133), 1-входной
With Command.Parameters("varAnalyse_Date")
   .Value = AccessArrayTable(2, AccessArrayRecordNum)
End With

Command.Parameters.Append Command.CreateParameter("varNotes", 129, 1, 254) 'Создаем параметр adChar(129), 1-входной
With Command.Parameters("varNotes")
   If IsNull(AccessArrayTable(21, AccessArrayRecordNum)) Then
       .Value = ""
   Else
       .Value = AccessArrayTable(21, AccessArrayRecordNum)
   End If
End With

Command.Execute
Set Command = Nothing

End Sub

Приведенная процедура является методом моего класса для работы с базой данных. В самом начале для соединения с MySQL используется объект Conn, который инициализируется в методе OperDB:

Код (vb) Выделить Развернуть


Public Sub OpenDB()
'Открыть соединение с базой данных на сайте
'Для успешной работы объекта предварительно требуется инсталляция ODBC MySQL Connector Driver
'Драйвер скачивается https://dev.mysql.com/downloads/connector/odbc/
'Для офиса 2003 разрядность драйвера 32bit не зависимо от разрядности Windows
'Правильное название драйвера при проиписывании строки-коннекта можно
'найти после инсталляции в ветке реестра
'HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers\

Dim ConnString ' Строка для коннекта
Dim Driver As String

Driver = "DRIVER={MySQL ODBC 8.0 Unicode Driver}" 'Драйвер для коннекта. Имя/версию драйвера приписать в фигурных скобках
Set Conn = CreateObject("ADODB.Connection")

ConnString = Driver & ";" & _
   "SERVER=" & ServerDB & ";" & _
   "PORT=" & PortDB & ";" & _
   "DATABASE=" & NameDB & ";" & _
   "UID=" & UserDB & ";" & _
   "PWD=" & PasswordDB & ";"
Conn.ConnectionTimeout = 5  'Время до обрыва ожидания соединения
Conn.Open ConnString

End Sub


Это всё предыстория. Подобным кодом, только с другой строкой для коннекта я базу данных Access заполнял без проблем. А вот с заполнением MySQL выскочила неожиданная проблема. При заполнении полей MySQL типа char обрезаются концевые пробелы в тексте.
Например, я передаю в качестве параметра в объект ADODB переменную со строкой такого вида "МОЙ ТЕКСТ  ". А в базе MySQL он появляется в таком виде "МОЙ ТЕКСТ".
Если в параметр ADODB попадает строка с точкой в середине, то все данные начиная от точки и далее обрезаются и в поле базы данных не поступают. Например:
"3257, Serials ...938AA and ...936AA are same catalysts." обрезается и в MySQL остается вот это - "3257, Serials"
Тех.поддержка сказала, что проблема скорее всего в наличие кавычек вокруг текста. По факту это так и оказалось. Если код в методе CopyRecord видоизменить таким образом:

Код (vb) Выделить Развернуть


Command.Parameters.Append Command.CreateParameter("varNotes", 129, 1, 254) 'Создаем параметр adChar(129), 1-входной
With Command.Parameters("varNotes")
   If IsNull(AccessArrayTable(21, AccessArrayRecordNum)) Then
       .Value = ""
   Else
       .Value = Chr(34) & AccessArrayTable(21, AccessArrayRecordNum) & Chr(34)
   End If
End With


тогда текст не усекается, передается полностью, но он в поле базы данных так и выглядит закавыченым. Полагаю, что проблема в особенности работы драйверов ODBC для MySQL, так как при экспорте данных в Access таких приколов с данными у меня не было. Кто-нибудь знает как извернуться, чтобы нормально передать текст в MySQL?

Здравствуйте.
Требуется прочитать текст из Combobox стороннего приложения через WinAPI.
На данный момент получается только получить индекс выбранного текста из списка командой

Код (vb) Выделить Развернуть

index = SendMessage(hwnd, CB_GETCURSEL, ByVal CLng(0), ByVal CLng(0))

Все остальные команды дают кракозябы. Даже длина текста определяется неправильно.

Код (vb) Выделить Развернуть

'TextLength = GetWindowTextLengthW(hwnd)
'TextLength = SendMessageW(hwnd, CB_GETLBTEXTLEN, ByVal index, ByVal 0)

Spy++ тоже неправильно читает комбо-бокс.

https://ibb.co/gdWZ0wh

Собственно, как прочитать текст (активный или по индексу) в комбо-бокс. Возможно дело в кодировке ANSI/UTF
но изменение декларации так же не помогает:

Код (vb) Выделить Развернуть


Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessageW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Спасибо.
TOPMOST меня не устраивает. Макрос должен отработать, и вывести окно Excel на передний план. Дальше окна пусть юзер переключает сам на свое усмотрение. Если останется свойство TOPMOST, окно Excel будет всегда поверх других приложений и будет мешать нормальной оконной работе.
Вообще спасибо за подсказку, сейчас почитаю какие ещё есть константы для этой функции, возможно она и есть то что надо.

P.S.Попробовал в варианте

Код (vb) Выделить Развернуть


Application.WindowState = xlMaximized
SetWindowPos Excel.Application.hwnd, HWND_TOP, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_DRAWFRAME

Не работает. Моргает, но в итоге Excel остается где-то внизу за приложением. Видимо сам Excel где-то у себя в процессе меняет состояние своего окна.
Есть идея, сделать не Excel HWND_TOP, а на приложение, с которым работал из VBA, установить HWND_BOTTOM

P.S.S.
Я лопух.
Вот такая строчка помогла

Код (vb) Выделить Развернуть


SetForegroundWindow Application.hwnd

Причем она в исходном коде в начале темы эта команда присутствовала, но похоже остальные команды её эффект как-то отменяли.

Здравствуйте.
Макрос взаимодействует с другими приложениями, после чего требуется, чтобы окно Excel стало активным (по верх всех окон). После танца с бубном и поиском в гугле пришел только к такому коду

Код (vb) Выделить Развернуть


Public Sub GetPCR()
'Получение результатов расчета по PCR (расчеты процедурой CalculatePCR)
'и перенос результата расчета в строку журнала анализов
Dim Y() As Double 'Переменная для получения результатов расчета

'CalculatePCR Y
'Buffer PCA:=True, Y:=Y 'Передаем данные в журнал анализов
SetForegroundWindow Application.hWnd
Application.WindowState = xlMinimized
Application.WindowState = xlMaximized
ShowWindow Application.hWnd, SW_SHOW
End Sub

При этом код не работает как надо. То есть я вижу, что окно Excel быстро-быстро моргает из-под другого приложения (например из VBA редактора, в котором я запускаю код по F5) - видимо на долю секунды Excel всё же становится активным, а затем вновь фокус передается в тот же редактор VBA или на окно приложения, вызванного из заремарченной процедуры. Не пойму в чем дело. Это сам Excel как-то неправильно работает. Стороннее приложение, с которым я работаю, по ShowWindow отлично обрабатывает команду и активируется.

Получилось через WinAPI сохранить в файл небольшой массив типа double размером 2х3 и восстановить данные из файла в другом массиве такого же размера.
Здесь код примера. Позже попробую этот вариант расширить под свою задачу

Код (vb) Выделить Развернуть


'Функции и константы для работы с файлами. Некоторые в данном примере не понадобятся.
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const OPEN_EXISTING = 3
Public Const FILE_BEGIN = 0
Public Const INVALID_HANDLE_VALUE = -1
Public Const CREATE_ALWAYS = 2
Public Const OPEN_ALWAYS = 4
Public Const FILE_END = 2
Public Type OVERLAPPED
 Internal As Long
 InternalHigh As Long
 offset As Long
 OffsetHigh As Long
 hEvent As Long
End Type

Public Const FILE_APPEND_DATA As Long = (&H4)

Public Const FILE_ATTRIBUTE_NORMAL As Long = &H80

'Public Const CREATE_NEW as Long=&H

Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Boolean
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long

Public Sub SaveData()
'Массив Arr сохраняется в файл FileName и читаем из файла данные в массив Arr2

Dim DataLength As Long
Dim Arr() As Double, Arr2() As Double
Dim hFile As Long
Dim Res As Long
Dim Filename As String

ReDim Arr(1 To 3, 1 To 2)
ReDim Arr2(1 To 3, 1 To 2)
Arr(1, 1) = 49
Arr(2, 1) = 49
Arr(3, 1) = 49
Arr(1, 2) = 50
Arr(2, 2) = 50
Arr(3, 2) = 50

Filename = "D:\TempData.dat"
'Открываем файл для записи. CREATE_ALWAYS - всегда создавать файл (это под мою задачу)
hFile = CreateFile(ByVal Filename, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
Res = WriteFile(hFile, Arr(1, 1), 2 * 3 * Len(Arr(1,1)), DataLength, 0)'Здесь 3-м параметром вычисляется количество элементов, умноженное на размер элемента в байтах
CloseHandle (hFile)

'Читаем массив из файла
hFile = CreateFile(ByVal Filename, GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
Res = ReadFile(hFile, Arr2(1, 1), 2 * 3 * Len(Arr(1,1)), DataLength, 0)
CloseHandle (hFile)

End Sub


Проверку на ошибки I/O я в коде не делал, просто сам факт, что такой метод может работать. Осталось адаптировать его под свой проект и посмотреть что получилось.

Часто пользуюсь FSO, но вроде бы он только с текстовыми потоками работает.
Вот тут хороший ресурс на его методы и свойства
http://www.script-coding.com/WSH/FileSystemObject.html#5.
Работа с бинарными данными вроде бы отсутствует.

Кое-что нашел в WinAPI - CreateFile, WriteFile.
Пробую с этим разобраться. Подозреваю, что придется по указателю сканировать память процесса, считывать массив оттуда и скидывать в файл. Отпишусь, если что-то получится.

Путем научного тыка выяснил, что длина одной записи в файл не может превышать 32767 байт (Excel 2003). Обидно. Идея хорошая, но для моего случая не очень работает. Если впихивать в файл массив поэлементно, то процесс создания длится почти минуту, для файла 1,7 Мб -  слишком долго для такого объема данных.

Кажется нашел решение

Код (vb) Выделить Развернуть


Option Explicit

Public Sub SaveData()
'Подсказка по работе с файлами в бинарном виде есть здесь
'http://forum.sources.ru/index.php?showtopic=328478

Dim i As Long
Dim FileName As String
Dim MyArr() As Double

FileName = "D:Savedata.dat"

ReDim MyArr(1 To 2, 1 To 2)
MyArr(1, 1) = 0.1
MyArr(1, 2) = 0.2
MyArr(2, 1) = 1
MyArr(2, 2) = 2


Open FileName For Random Access Write As #1 Len = 512' 512- зарезервированный размер данных на диске под мой файл
Put #1, 1, MyArr
Close #1

End Sub


Попробовал наваять код  с помощью подсказки на стороннем ресурсе.
Получилось сохранить весь массив целиком. Код откомпилировался и отработал без ошибок. Получился файлик размером 50 байт. Полагаю, что 32 байта пошло на 4 числа типа double, остальные 18 байт на параметры динамического массива. С одномерным массивом тоже всё красиво.
Попробую реализовать данную идею под свою задачу

P.S. Попробовал адаптировать данный код к своему примеру
При выполнении команды

Код (vb) Выделить Развернуть

Open FileName For Random Access Write As #1 Len = DataLength
При DataLength=229304 байт появляется сообщение об ошибке Overflow.
Тут что, стоит ограничение в 64 кБ? Совсем беда.

Нет. Не в Excel. В произвольный бинарный файл. Например MyData.dat. Массив достаточно большой. Например 500х2048. В лист такой не влезет. Плюс если сохранять данные на листе, Excel очень медленно это делает. В бинарном виде всё происходит почти мгновенно.

Здравствуйте.
Имеется большая матрица коэффициентов типа double в двумерном динамическом массиве. Хочу сохранить матрицу в файл. Числа типа double в текстовом виде хранить нерационально, тем более что double памяти занимает всего 8 байт. Есть ли на VBA возможность сохранить массив double в файл? На C++ для этого есть библиотечная функция fwrite. Возможно VBA сделает то же самое через Win API? Думаю, что через цикл for и чтение памяти для каждого элемента массива я наверное сделал бы и сам, но этот способ медленный. В связи с этим ещё будет обратная задача. Этот массив потребуется восстанавливать обратно из файла в область памяти массива.
Подскажите рациональное решение.

У меня вот такой блок

Код (vb) Выделить Развернуть


FileName = FileName & ".xls"
#If VBA7 Then
   ThisWorkbook.SaveAs FileName:=Path & FileName, FileFormat:=56
#Else
   ThisWorkbook.SaveAs FileName:=Path & FileName
#End If
Unload Form_Passport

Он выполняет сохранение файла перед закрытием формы в формате .xls
Пошагово выполняю его через клавишу F8
Сначала маркер выполняемой команды стоит на строке Filename=...
Клавишей F8 он перепрыгивает через всю систему директив и устанавливается на Unload. Т.е. пропускается как проверка на VBA7, так и #Else впринципе.
У меня офис 2003, т.е. должен выполняться вариант в блоке #Else
Попытка установить маркер на ThisWorkbook.SaveAs FileName:=Path & FileName перетаскиванием маркера мышкой на строку с командой, он перетаскиваться не хочет, опять устанавливается на Unload Form_Passport
Думал, что где-то слетели настройки компилятора, но я их не нашел. Антивирь может и не виноват. Не знаю.


Только что заремарчил блок директив, оставил только команду из блока #Else. Прогнал программу, затем отремарчил. Всё вновь стало хорошо работать. Какой-то был глюк. Причем очень настойчивый. Простой перезапуск книги с макросом проблему не исправлял. В чем было дело, я так и не понял. К сожалению, по теме я больше никакой информации больше сообщить не смогу, так как сама собой разрешилась непонятно как.

Не с того ни с сего перестали выполняться директивы #if... #else... #then
Блок просто пропускается. Принудительное выполнение в пошаговом режиме отладки перемещением на команду маркера тоже не получается, маркер не хочет выставляться. Грешу на касперского, который просил обновиться с перезагрузкой.
Офис 2003. В блоке классическая проверка на vba7

Написал макрос, который через запрос Access должен заносить в таблицу с текстовым полем строковое выражение из ячеек Excel. В общем случае для численно-буквенных выражений макрос работает,  но когда в выражении появляется знак косой черты "/", выбивается ошибка: "Приложение использует для текущей записи значение неверного типа".
Предполагаю, что косая черта при работе с SQL-запросами относится к каким-то запрещенным для использования знакам. Сам по себе ввод этого символа при ручном заполнении таблицы никаких ошибок не вызывает. Т.е. теоретически обойти ограничение на передачу текстовой строки с косой чертой возможно. Подскажите кто с этим сталкивался и как с этим справиться?


Можно пойти более хитрым путем, заносить вместо косой черты какой-нибудь символ типа знака подчеркивания, а при чтении таблицы Access средствами VBA вновь знак подчеркивания менять на косую черту, но мне бы хотелось иметь полное соответствие c исходником в Excel

Извиняюсь. Нашел у себя ошибку. При передачи данных выставил ограничение на текстовую строку 10 байт вместо 150. Просьба модератора удалить тему.

Size - это объем автомобильных двигателей. Типа 2,0; 4,5. Там точность double не нужна, и этим экономится память в базе данных. Предполагается, что объем таблицы будет более 10 тыс записей. Я сайз передаю в метод пользовательского класса, который будет сохранять данные в Access. В метод класса величины попадают из ячеек Excel. С округлением пробовал, не помогало.

К топику темы прикреплены файл Excel и таблица Access - там можно поюзать. Все способы перепробовал, ничего не помогало, пока не заменил в параметрах на тип Single - константа 4. При такой передаче Access сам сконвертил в adDecimal. Меня это устроило. Просто пишу класс с перспективой переделать под SQL-сервер. С SQL-сервером я подобные задачи уже решал, там таких проблем не было.Это особенность Access